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I.         BACKGROUND 

Much  research  into  the  formalization  and  automation  of  software  development 
is  underway.  The  need  for  such  tools  is  obvious.  It  is  fundamentally  driven  by  Moore's 
Law,  which  states  that  the  power  of  computer  systems  will  double  every  18  months — 
a  maxim  which  has  held  for  the  past  twenty  years,  and  is  expected  to  continue  for  at 
least  the  next  ten.  As  computer  systems  grow  inexorably  faster  and  more  powerful, 
new  software  to  take  advantage  of  this  increased  power  is  needed.  The  new  software, 
however,  is  larger,  and  more  complicated,  and  now  requires  larger  teams  of  developers 
to  produce  in  a  timely  manner.  Software  tools  to  manage  the  complexity  of  developing 
these  larger  programs  are  needed. 

One  such  tool  is  the  Evolutionary  Control  System  (ECS)  being  developed  at 
the  Naval  Postgraduate  School  (NPS).  The  basis  of  the  ECS  is  Salah  Badr's  Phd. 
Thesis,  A  Model  and  Algorithms  for  a  Software  Evolution  Control  Sysiem[Ref.  1], 
which  itself  was  based  on  work  by  Luqi[Ref.  4]  of  NPS. 

Salah's  thesis  delved  into  a  broad  array  of  issues  related  to  managing  large 
projects  and  their  concomitant  complexity.  One  aspect  of  his  thesis,  which  is  the  sub- 
ject of  this  report,  was  the  development  and  implementation  of  an  on-line  scheduling 
algorithm  that  did  three  specific  tasks: 

1.  Supported  teamwork  by  concurrently  assigning  ready  steps  to  available  de- 
signers. 

2.  Supported  incremental  replanning  as  additional  information  became  available. 

3.  Minimized  wasted  design  effort  due  to  reorganization  of  the  schedule  by  effi- 
ciently scheduling  workers  to  assigned  sub-tasks. 

Over  time,  however,  certain  limitations  have  become  evident.  The  implemen- 
tation of  the  scheduling  algorithm  was  found  to  be  0(N2)  in  space.  This  led  to  a 
rapid  exhaustion  of  memory  resources  on  relatively  small  problem  sets.  Also,  the 
model  of  time  used  to  schedule  the  developers  was  not  realistic.  It  assumed  that  the 


developers  were  available  always,  and  did  not  take  into  account  weekends,  holidays, 
or  other  commitments  on  a  developer's  time.  Also,  the  capabilities  of  the  developers 
was  split  into  just  three  broad  categories:  low,  medium,  and  high.  This  too  proved 
unrealistic,  as  certain  developers  bring  their  own  strengths  and  weaknesses  to  the 
task  at  hand.  It  would  be  nice  to  take  note,  for  instance,  of  a  special  ability  such 
as  database  expertise,  and  assign  a  programmer  with  this  capability  to  a  task  that 
require  this  knowledge.  The  changes  made  to  Salah  Badr's  codes  do  exactly  this. 


II.         THE  SCHEDULER 

The  problem  of  optimally  scheduling  tasks  for  both  the  preemptive  and  nonpre- 
emptive  cases  is  NP-complete[Ref.  6].  Scheduling  nonpreemptive  tasks  with  arbitrary 
ready  times  is  also  NP-complete  in  both  multiprocessor  and  uniprocessor  systems [Ref. 
3].  For  dynamic  systems  with  more  than  one  task,  and  mutual  exclusion  constraints 
between  tasks,  Mok  and  Dert  ouzos  [Ref.  5]  showed  that  an  optimal  scheduling  algo- 
rithm does  not  exist. 

Shiah,  et  al.[Ref.  2]  came  up  with  an  heuristic  scheduling  algorithm  that  ran  in 
order  kN  time.  Salah  Badr  extended  the  algorithm  to  consider  arbitrary  precedence 
constraints  between  pairs  of  tasks.  His  scheduler  forms  the  basis  of  the  current  ECS 
scheduling  algorithm. 

The  scheduling  algorithm,  as  implemented  by  Badr,  was  recursive.  It  con- 
sumed order  N2  memory  for  a  set  of  N  tasks.  It  attempted  to  improve  performance 
by  limiting  backtracking,  but  was  still  at  least  order  N2  in  time.  It  was  based  on 
an  algorithm  described  in  the  paper  by  Stankovic,  et  al.[Ref.  3]  The  requirement  for 
order  N2  space  limited  the  size  of  the  problem  domain.  This  thesis  describes  the 
algorithm  and  the  steps  taken  to  make  the  algorithm  run  using  only  order  N  space. 
It  is  based  on  the  "myopic"  algorithm  [Ref.  2]  and  a  radical  restructuring  of  the  data 
structures  in  the  Ada  code. 

A.      THE  SCHEDULING  MODEL 

The  task  set  in  the  ECS  scheduling  problem  is  a  variable  set  of  evolution 
steps  S  =  {5i,  Sz, . . . ,  Sn},  where  N  varies  with  time.  This  set  of  tasks  needs  to  be 
scheduled  to  a  set  of  M  designers  D  =  {Di,  D2,  •■  ■ ,  Dm}-  The  designers  are  of  L 
different  expertise  levels. 

Tasks  as  used  in  the  ECS  are  independent,  nonperiodic  and  non-preemptive. 
They  can  be  characterized  by  the  following: 


1.  Task  arrival  Time  Ta\ 

2.  Task  deadline  Tp; 

3.  Task  worst-case  computation  time  Tq\ 

4.  Task  expertise  level  Tj,; 

5.  Task  priority  Tp 

Each  task  also  has  associated  with  it  a  precedence  constraint  given  in  the  form 
of  a  directed  acyclic  graph  G  —  {S,E}  such  that  (S{,Sj)  €  E  implies  that  Sj  cannot 
start  until  Si  has  completed. 

The  priority,  Tp,  is  a  small  positive  integer  that  is  assigned  to  each  task  to 
reflect  the  criticality  of  its  deadline.  The  priorites  of  different  tasks  should  be  com- 
patible with  the  precedence  constraints  between  the  steps,  i.e.  no  lower  priority  step 
can  precede  a  higher  priority  step: 

ii(S2,S1)eE^TP(2)>=Tp(l) 
if  (52,  S1)eEA  TP{1)  >=  TP(3)  =>  TP{2)  >=  TP(3) 

B.      THE  SCHEDULING  ALGORITHM 

The  goal  of  the  scheduling  algorithm  is  to  determine  if  there  exists  a  schedule 
for  executing  the  tasks  that  satisfies  the  timing  ,  precedence,  and  resource  constraints, 
and  to  calculate  such  a  schedule  if  it  exists.  A  schedule  that  meets  these  constraints 
is  termed  feasible.  It  is  not  guaranteed  to  be  optimal. 

Scheduling  a  set  of  tasks  to  find  a  full  feasible  schedule  is  actually  a  search 
problem.  The  search  space  is  a  tree.  The  scheduling  algorithm  starts  at  the  root  of 
the  tree,  and  using  a  predetermined  heuristic,  selects  a  candidate  task  to  schedule.  If 
the  remaining  tasks  can  be  added  to  the  schedule,  in  the  order  given  by  the  heuristic, 
without  violating  the  constraints,  then  the  partial  schedule  is  termed  strongly- feasible, 
and  the  task  is  added  to  the  search  tree  as  a  vertex  node,  and  the  process  is  repeated , 
recursively,  till  a  full,  feasible  schedule  is  found.  If  instead,  after  the  candidate  task  is 


selected,  and  any  one  of  the  remaining  tasks  added  to  the  schedule  violates  the  con- 
straints, the  candidate  task  is  rejected,  and  the  next  elgible,  candidate  task  (ordered 
by  the  ranking  function  H(T))  is  selected.  The  search  process  continues  untill  all  the 
tasks  are  scheduled,  or  no  feasible  schedule  is  found. 

Instead  of  using  all  of  the  remaining  tasks  to  determine  if  a  partial  schedule 
is  strongly-feasible,  Stankovic,  et  al.[Ref.  2],  limited  the  candidate  tasks  to  check 
to  some  number  k.  So,  insteady  of  checking  N,  N  —  1, . . . ,  1  remaining  tasks,  or 
N(N  —  l)/2  total  tasks,  they  limited  the  search  to  k  or  at  most  kN  tasks  to  check. 
(This  is  where  the  term  "myopic"  comes  in.  Instead  of  looking  at  all  the  remaining 
tasks,  we  "near-sightedly"  examine  the  next  k  tasks.) 

The  set  of  tasks  ready  to  be  scheduled  are  ordered  by  the  heuristic  H(T).  The 
candidate  heuristics  are 

1.  Minimum  deadline  first  (Min_D):  H(T)  =  TD; 

2.  Minimum  processing  time  first  (Min_P):  H(T)  =  Tp\ 

3.  Minimum  earliest  start  time  first  (Min_S):  H{T)  —  Teat\ 

4.  Minimum  laxity  first  (Min_L):  H(T)  =  TD  -  (Teat  +  TP); 

5.  MinJD  +  Min_P:  H{T)  =  TD  +  W  xTP; 

6.  Min_D  +  Min_S:  H(T)  =  TD  +  W  x  Teat; 

According  to  Shiah  et  al.[Ref.  3],  The  MinJD  +  Min_S  heuristic  is  superior  in  all 
cases.  It  is  supposedly  used  in  Salah  Badr's  dissertation,  but  since  his  simulation 
studies  apparently  used  tasks  with  an  earliest  start  time  of  0  it  defaults  to  Min_D. 
MinJD  is  used  in  the  new  implementation  of  the  scheduling  algorithm. 

C.      ANALYSIS 

The  scheduler  as  implemented  by  Salah  Badr  in  Ada  was  Order  N-squared 
in  space.  The  heart  of  the  code  was  a  call  on  a  search  function  performing  a  recur- 
sive search  in  tree-like  fashion  of  potential  schedules.   In  order  to  make  the  routine 
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Figure  1.  Plot  of  scheduler  run-time  vs.  number  of  tasks  to  schedule 

O(N)  in  space  it  was  necessary  to  pull  many  of  the  large  data  structures  out  of  the 
recursive  routine,  make  them  global,  and  manage  changes  with  other  global  data 
structures.  This  necessarily  complicated  the  code  to  a  degree,  but  the  result  was  an 
O(N)  algorithm  in  space. 

Once  the  space  problem  was  corrected,  it  became  evident  that  the  routine  was 
also  0(N2)  in  time.  But  this  was  easily  rectified  by  using  the  "myopic"  algorithm. 
Figure  1  shows  the  speed-up  in  processing  speed  vs.  number  of  tasks  to  be  scheduled 
for  different  versions  of  the  code.  The  original  data  came  with  the  original  code. 
After  the  N2  space  problem  was  resolved,  and  before  the  myopic  version  of  the  code 
was  added  (first  cut)  we  see  that  the  code  still  runs  in  order  N2  time.  The  final  cut 
shows  the  run-time  for  the  final  version  of  the  code. 

The  original  data  collected  goes  upto  only  4600  tasks  because  the  storage 
required  was  0(N2)  in  the  number  of  tasks  to  be  scheduled.  A  number  larger  than 
4600  tasks  would  cause  the  program  to  raise  a  storage-error  exception. 
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Figure  2.  Plot  of  Laxity  vs.  percent  schedules  found 


D.      SIMULATION 

To  test  the  new  scheduler  routine,  a  routine  to  generate  tasks  that  always  have 
a  feasible  schedule  was  written.  (Actually  Badr  had  a  routine  to  generate  tasks,  but 
it  generated  lists  of  tasks  that  were  "easy"  to  schedule — that  is  the  alogorithm  never 
failed  to  find  a  schedule.)  This  routine  varies  the  number  of  tasks,  the  number  of 
programmers  to  use,  and  the  "laxity"  of  the  schedule  generated.  (Laxity  is  denned 
to  be  Td  —  (Test  +  Tp).)  It  also  uses  the  Ada  '95  random  number  generators  to 
generate  uniform  distributions  of  random  variables.  The  graph  in  Figure  2  shows 
the  performance  of  the  algorithm  when  500  tasks  per  test  case  were  generated,  and 
the  laxity  was  varied  between  zero  and  0.7.  As  you  can  see,  the  algorithm  failed 
miserably  when  there  was  zero  laxity,  and  got  progressively  better  as  this  constraint 
was  "relaxed." 


III.         CALENDAR 

The  scheduling  algorithm  as  originally  implemented  treated  time  continuously. 
Mapping  this  "continuous"  time  to  calendar  working  time  is  a  tedious  task,  especially 
as  the  number  of  tasks  to  schedule  increases.  Also,  real  dates  give  a  better  idea  of 
the  time- frames  involved. 

The  algorithm  to  translate  a  "continous"  time  to  calendar  time  works  as  fol- 
lows: Consider  the  output  of  the  scheduler  in  Table  I  for  a  simple  set  of  10  tasks. 

The  first  column  is  the  task  id,  the  second  column  is  the  expertise  level  required 
for  the  task  (more  on  expertise  levels,  later),  and  the  third  column  is  the  developer 
assigned  to  the  task.  (In  this  case  we  have  three  developers:  LI,  Ml,  HI.)  The  second 
to  last  column  is  the  start  time  and  the  last  column  is  the  end  time  in  units  of  hours. 

After  translating  the  start  times  and  end  times  to  calendar  times  we  get  the 
output  in  Table  II  For  this  data  set  the  start  date  was  set  to  July  3rd,  1997.  The 
translator  also  assumed  that  the  work  day  is  eight  hours.  At  NRaD  the  the  work 
weeks  are  5/4,  i.e.,  9  hours  a  day  on  Monday  thru  Thursday  and  8  hours  on  Friday, 
with  every  other  Friday  off.  Using  -nrad  as  an  input  switch  to  the  program,  we  get 
the  new  output  shown  in  Table  III. 

The  dates  in  Table  III  start  on  the  seventh  of  July  because  July  4th  is  a  federal 
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HI 
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LOW 
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HIGH 
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13 
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MEDIUM 
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12 
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LOW 

LI 
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10 
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MEDIUM 

Ml 

12 

14 

7 

LOW 

LI 

10 

15 

9 

HIGH 

HI 

13 

19 

10     MEDIUM     Ml     14     24 
Table  I.  Raw  output  of  Scheduler 


3  HIGH  HI  07/03/1997+00  07/03/1997+03 
2  MEDIUM  Ml  07/03/1997+00  07/03/1997+04 
1  LOW  LI  07/03/1997+00  07/03/1997+06 

4  HIGH  HI  07/03/1997+03  07/07/1997+05 

5  MEDIUM  Ml  07/03/1997+04  07/07/1997+04 

6  LOW  LI  07/03/1997+06  07/07/1997+02 

8  MEDIUM  Ml  07/07/1997+04  07/07/1997+06 

7  LOW  LI  07/07/1997+02  07/07/1997+07 

9  HIGH  HI  07/07/1997+05  07/08/1997+03 

10  MEDIUM  Ml  07/07/1997+06  07/08/1997+08 

Table  II.  Standard  Work  Day 


3  HIGH  HI  07/07/1997+00  07/07/1997+03 
2  MEDIUM  Ml  07/07/1997+00  07/07/1997+04 
1  LOW  LI  07/07/1997+00  07/07/1997+06 

4  HIGH  HI  07/07/1997+03  07/08/1997+05 

5  MEDIUM  Ml  07/07/1997+04  07/08/1997+04 

6  LOW  LI  07/07/1997+06  07/08/1997+02 

8  MEDIUM  Ml  07/08/1997+04  07/08/1997+06 

7  LOW  LI  07/08/1997+02  07/08/1997+07 

9  HIGH  HI  07/08/1997+05  07/09/1997+03 

10  MEDIUM  Ml  07/08/1997+06  07/09/1997+08 

Table  III.  NRaD  Schedule 

holiday,  and  an  NRaD  off-Friday,  this  moves  the  off-Friday  to  the  3rd,  so  the  first 
work-day  is  actually  the  seventh.  It  appears  complicated,  but  the  Ada  implementation 
handles  it  quite  easily.  The  format  of  MM/DD/YYYY+HR  is  used  because  daily  schedules 
are  idiosyncratic.  The  notation  "+HH"  means  start  or  finish  at  that  many  hours  into 
the  workday.  It  should  be  easy  to  map  this  time  format  to  any  person's  particular 
schedule,  but  in  the  interest  of  time  was  not  done  here. 

The  calendar  package  will  also  compute  non-federal  holidays  such  as  Easter, 
election-day,  and  other  useful  dates.  The  present  version  runs  in  order  N2  time.  It 
should  be  easy  to  convert  to  order  N,  but  due  to  time  constraints,  this  was  not  done 
during  the  course  of  this  thesis.    The  calendar  package  was  originally  added  to  the 
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scheduler,  but  it  didn't  make  sense  to  take  an  order  N2  algorithm,  turn  it  into  an 
order  N  one,  then  turn  it  back  to  an  order  N2  one  with  the  addition  of  the  calendar 
package.  Besides,  the  scheduler  is  used  to  come  up  with  feasible  schedules.  Once  one 
is  obtained,  it  can  then  be  easily  mapped  to  calendar  dates.  This  separation  of  tasks 
also  preserves  the  modularity  of  the  codes.  The  conversion  routine  to  convert  from 
"continuous-time"  to  calendar  dates  (contocal)  is  in  one  of  the  appendices,  as  part 
of  the  scheduler  package. 
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IV.         EXPERTISE  LEVELS 

Every  programmer  brings  certain  competencies  to  the  tasks  at  hand.  Some 
are  experts  in  Ada,  others  in  Java,  etc.  So,  the  scheduler  has  been  modified  to  handle 
this. 

In  the  Shiah,  et  al.  paper[Ref.  3]  on  scheduling  multiple  tasks,  resources  are 
represented  by  a  vector  data  structure  as  follows: 

EAT  =  (EATU  EAT2, ...,  EATr) 

(EAT  stands  for  earliest  available  time.)  If  a  task  is  ready  to  be  scheduled,  and 
it  requires  resource  N,  the  earliest  it  can  be  scheduled  is  at  time  EATjq.  If  there 
are  multiple  instances  of  a  resource  then  the  resources  are  represented  as  a  matrix, 
and  the  earliest  time  a  task  can  be  scheduled  is  the  earliest  time  any  one  of  the 
multiple  instances  of  that  resource  is  available.  In  Salah  Badr's  thesis,  he  represented 
developers  as  the  resources,  and  since  he  classified  them  as  (low,  medium,  high)  he 
could  have  multiple  instances  of  developers.  So  the  data  structure  to  represent  the 
available  resources  (developers)  was  a  matrix. 

In  this  latest  revision  of  the  code,  each  developer  is  unique,  there  are  no 
multiple  instances  of  a  developer,  so  resources  (developers)  are  representeted  as  a 
vector.  Each  developer,  though,  has  a  capability  attribute,  which  is  a  map  of  skills  to 
(low,  medium,  high).  For  example,  one  of  the  inputs  to  the  new  scheduler  program 
is  a  file  of  developers,  as  shown  in  Table  IV. 

Each  developer  has  an  implicit  attribute  which  is  their  name.  Also,  if  a  capa- 
bility is  not  given,  it  is  assumed  to  be  low.  For  example  developer  "Scott  McNealy" 

Bill  Gates  {ActiveX  :  High,  Java  :  Low} 

Scott  McNealy     {Java  :  High,  Unix  :  Medium} 
Bill  Joy  {Java  :  High,  Unix  :  High} 

Table  IV.  Sample  developer  file 
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Bill  Gates  {ActiveX  :  High,  Java  :  Low,  Unix  :  Low, 

Bill  Gates  :  High,  Scott  McNealy  :  Low,  Bill  Joy  :  Low} 

Scott  McNealy     {ActiveX  :  Low,  Java  :  High,  Unix  :  Medium, 

Bill  Gates  :  Low,  Scott  McNealy  :  High,  Bill  Joy  :  Low} 

Bill  Joy  {ActiveX  :  Low,  Java  :  High,  Unix  :  High, 

Bill  Gates  :  Low,  Scott  McNealy  :  Low,  Bill  Joy  :  High} 

Table  V.  Sample  developer  file  with  implicit  capabilities 

is  assumed  to  have  low  ActiveX  skills,  while  developer  "Bill  Gates"  is  assumed  to 
have  low  Unix  skills.  If  a  task  is  to  be  scheduled  that  requires  medium  Unix  skills 
and  low  ActiveX  skills  then  either  developer  "Scott  McNealy"  or  "Bill  Joy"  could  be 
assigned.  On  the  other  hand,  if  a  task  requires  high  ActiveX  skills,  then  only  "Bill 
Gates"  would  fit  the  bill.  If  a  task  came  in  that  required  high  skills  in  both  ActiveX 
and  Java,  no  developer  would  fit  the  bill,  and  the  scheduler  code  would  through  an 
Ada  (noqualif  ieddevelopers)  exception.  If  a  job  came  in  that  required  high  or 
medium  skills  in  attribute  "Scott  McNealy"  then  only  he  could  possibly  be  assigned 
this  job.  Table  V  shows  what  the  capabilities  of  each  developer  are  with  the  implicit 
capabilities  added. 
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V.         CONCLUSIONS 

A.  SUMMARY  OF  DESIGN  AND  IMPLEMENTATION 

The  scheduler  as  implemented  can  now  handle  large  problems  in  a  reasonable 
time,  i.e.,  ten  thousand  or  more  tasks.  The  scheduled  tasks  can  now  be  mapped  to  a 
realistic  calendar,  and  the  tasks  are  now  associated  with  problem- solving  skills 

B.  FUTURE  WORK 

The  calendar  implementation  needs  to  be  optimized.  It  currently  runs  in  order 
N2  time,  but  could  easily  be  modified  to  run  in  order  N  time.  At  present  the  calendar 
model  does  not  consider  individual  variations  in  schedules.  If  a  developer  were  to  take 
a  day  off,  the  model  cannot  handle  that,  as  it  is  only  aware  of  work  days  and  holidays 
for  the  general  work-force.  To  allow  individual  schedules  into  the  model  a  group 
planning  program  of  some  kind  would  be  needed.  A  kludge  to  get  around  this  in  the 
present  implementaton,  is  to  create  pseudo-tasks  lasting  the  period  of  time  off,  and 
requiring  only  that  particular  developer  perform  it.  This  causes  some  inaccuracies 
because  the  current  scheduler  in  non-preemptive,  but  in  real  life  time  off  could  be 
scheduled  in  the  middle  of  a  task.  This  weakens  the  algorithm  because  it  can  fail  to 
find  feasible  schedules  in  which  tasks  are  interrupted  by  time  off. 

Another  enhancement  that  would  be  useful  is  the  identification  of  critical 
paths.  All  schedules  have  critical  paths,  that  is  a  sequence  of  tasks  with  the  least 
laxity.  It  would  be  nice  to  enhance  the  scheduler  to  identify  these  critical  paths.  The 
project  manager  could  then  can  focus  his  attention  on  those  tasks  in  the  critical  path, 
as  these  would  be  the  jobs  that  puts  his  schedule  most  at  risk. 
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§         APPENDIX  A  INTRODUCTION 

1.  Introduction.  Here  is  the  Ada  code  for  utilites  used  in  Salah  Badr's  scheduler 
program.  His  program  was  written  by  him  May  25,  1993.  It  was  translated  by  myself, 
John  Evans  of  NRaD,  into  Donald  Knuth's  WEB  format  for  literate  programming.  To 
compile  and  link  the  code  in  its  present  format  you  will  need  the  Ada  version  of  the  WEB 
tool. 

It  is  available  on-line  via  the  world-wide-web  at  URL: 

http://white.nosc.mil/~evansjr/hterate/ 


2.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
get  the  book  Literate  Programming,  by  Donald  Knuth,  published  by  the  Center  for  the 
Study  of  Language  and  Information,  Stanford  University,  1992.  Another  good  source  of 
information  is  the  Usenet  group  comp. programming. literate.  It  has  information  on  tools 
and  answers  to  Frequently  Asked  Questions  (FAQs). 

3.  Who  should  use  the  WEB  paradigm  for  programming?  Well,  not  everybody.  Here  are 
a  few  paragraphs  from  Donald  Knuth's  book  that  explains  it  best. 

4.  Retrospect  and  Prospects.  Enthusiastic  reports  about  new  computer  languages, 
by  the  authors  of  those  languages,  are  commonplace.  Hence  I'm  well  aware  of  the 
fact  that  my  own  experiences  cannot  be  extrapolated  too  far.  I  also  realize  that, 
whenever  I  have  encountered  a  problem  with  WEB,  I've  simply  changed  the  system; 
other  users  of  WEB  cannot  operate  under  the  same  ground  rules. 

5.  However,  I  believe  that  I  have  stumbled  on  a  way  of  programming  that  produces 
better  programs  that  are  more  portable  and  more  easily  understood  and  maintained 
than  ever  before;  furthermore,  the  system  seems  to  work  with  large  programs  as 
well  as  with  small  ones.  I'm  pleased  that  my  work  on  typography,  which  began  as 
an  application  of  computers  to  another  field,  has  come  full  circle  and  become  an 
application  of  typography  to  the  heart  of  computer  science;  I  like  to  think  of  WEB  as 
a  neat  "spinoff"  of  my  research  on  IgX.  However,  all  of  my  experiences  with  this 
system  have  been  highly  colored  by  my  own  tastes,  and  only  time  will  tell  if  a  large 
number  of  other  people  will  find  WEB  to  be  equally  attractive  and  useful. 
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6.  I  made  a  conscious  decision  not  to  design  a  language  that  would  be  suitable  for 
everybody.  My  goal  was  to  provide  a  tool  for  system  programmers,  not  for  high 
school  students  or  for  hobbyists.  I  don't  have  anything  against  high  school  students 
and  hobbyists,  but  I  don't  believe  every  computer  language  should  attempt  to  offer 
all  things  to  all  people.  A  user  of  WEB  needs  to  be  good  enough  at  computer  science 
that  he  or  she  is  comfortable  dealing  with  several  languates  simultaneously.  Since 
WEB  combines  T^X  an(l  Pascal  with  a  few  rules  of  its  own,  WEB  programs  can  contain 
WEB  syntax  errors.  TgX  syntax  errors,  Pascal  syntax  errors,  and  algorithmic  errors; 
in  practice,  all  four  types  of  errors  occur,  and  a  bit  of  sophistication  is  needed  to 
sort  out  which  is  which.  Computer  specialists  tend  to  be  better  at  such  things  than 
other  people.  I  have  found  that  WEB  programs  can  be  debugged  rapidly  in  spite  of 
the  profusion  of  languages,  but  I'm  sure  that  many  other  intelligent  people  will  find 
such  a  task  difficult. 

7.  In  other  words,  WEB  seems  to  be  specifically  for  the  peculiar  breed  of  people  who 
are  called  computer  scientists.  And  I'm  pretty  sure  that  there  are  also  a  lot  of 
computer  scientists  who  will  not  enjoy  using  WEB;  some  of  us  are  glad  that  tradi- 
tional programming  languages  have  comparatively  primitive  capabilities  for  inserted 
comments,  because  such  difficulties  provide  a  good  excuse  for  not  documenting  pro- 
grams well.  Thus,  WEB  may  be  only  for  the  subset  of  computer  scientists  who  like 
to  write  and  to  explain  what  they  are  doing.  My  hope  is  that  the  ability  to  make 
explanations  more  natural  will  cause  more  programmers  to  discover  the  joys  of  lit- 
erate programming,  because  I  believe  it's  quite  a  pleasure  to  combine  verbal  and 
mathematical  skills;  but  perhaps  I'm  hoping  for  too  much.  The  fact  that  a  least 
one  paper  has  been  written  that  is  a  syntactically  correct  ALGOL  68  program  en- 
courages me  to  perservere  in  my  hopes  for  the  future.  Perhaps  we  will  even  one  day 
find  Pulitzer  prizes  awarded  to  computer  programs. 

8.  Donald  Knuth  goes  on  to  write  about  his  hopes  for  the  future  of  WEB  programming. 
In  an  interview  with  Donald  Knuth  by  Amazon  Books  on  the  release  of  a  new  edition  of 
Volume  1  of  The  Art  of  Computer  Programming  (July  1,  1997)  he  was  asked: 
Amazon.com:  What  do  you  see  as  the  most  interesting  advance  in  programming  since 
you  published  the  first  edition? 

Donald  Knuth:  It's  what  I  call  literate  programming,  a  technique  for  writing,  docu- 
menting, and  maintaining  programs  using  a  high-level  language  combined  with  a  written 
language  like  English.  This  is  discussed  in  my  book  Literate  Programming. 

9.  In  the  same  book,  Literate  Programming,  there  is  a  chapter  called  How  to  read  a  WEB. 
But  it  is  actually  quite  straightforward. 
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10.  Very  briefly,  each  "Module"  within  angle  brackets  (<  >)  is  expanded  somewhere 
further  down  in  the  document.  The  trailing  number  you  see  within  the  brackets  is  where 
you  can  find  this  expansion.  This  provides  a  type  of  PDL  (program  descriptor  language) 
for  your  program  and  greatly  aids  modularity  and  readability.  It  is  also  a  highly  effective 
method  of  top-down  programming.  The  first  module  here  is  expanded  further  down,  and 
contains  most  of  the  structure  in  standard  Ada  packages. 

(  Package  boiler-plate  12 ) 
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11.  Schedule  Tools. 

12.  Here,  finally,  is  the  boilerplate.  The  Ada  WEB  tool  atangle  reads  this  and  knows  to 
write  out  two  separate  files,  the  specification  and  the  body.  (The  Ada  WEB  tool  aweave 
will  write  out  just  one  documentation  file.) 

(  Package  boiler-plate  12  )  = 

output  to  file  schedtools  .ads 

with  Text  JO ; 
use  Text  JO; 
with  genericsetjpkg; 
with  genericjmap-pkg ; 
with  Generic Jist; 
with  SchedPrims ; 
use  SchedPrims ; 
with  capability] 
use  capability; 
with  ustrings; 
use  ustrings; 
package  schedtools  is 

(Instantiate  generics  16) 

(  Specification  of  types  and  variables  visible  from  schedtools   23  ) 

(  Specification  of  procedures  visible  from  schedtools   26  ) 
end  schedtools ; 

output  to  file  schedtools. adb 

with  test-io-pkg; 

use  test-io-pkg; 

with  Ustrings;   Use   Ustrings;  with  Ada. calendar; 

use  Ada. calendar; 

with  calyr; 

use  calyr; 

with  capability ; 

use  capability ; 

package  body  schedtools  is 

( Variables  local  to  schedtools  41 ) 

(  Procedures  and  Tasks  in  schedtools   42 ) 
end  schedtools ; 
This  code  is  used  in  section  10. 
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13.      The  scheduling  tools  in  this  package  rely  on  some  other  packages.  Here  is  how  they 
relate  to  each  other. 

Generic  List  Pkg  SchedPrims  Pkg 


SchedTools  Pkg 


I 


Scheduler 

Library  Dependence  Structure. 

14.  The  schedules  are  kept  in  in  linked-lists.  Salah  Badr's  original  code  had  separate 
routines  for  each  linked  list.  In  this  version  of  the  algorithm,  I  created  a  generic  list  type, 
and  make  multiple  instantiations  of  it  for  different  record  types.  Details  of  the  differing 
records,  comparisons,  and  display  routines  can  be  found  in  the  schedprims  package. 

15.  Since  the  main  purpose  of  rewriting  the  code  was  to  eliminate  the  order  N2  space 
requirement,  I  use  linked  lists  to  keep  track  of  additions  and  deletions  to  the  lists  as  the 
search  space  is  traversed.  What  follows  are  all  the  instantiations  of  new  linked-lists. 

16.  Here  I  instantiate  a  list  type  to  manipulate  Step  Record  types. 

( Instantiate  generics  16 )  = 

package  InputListl  is  new  GenericJist(ElementType  =>  StepRecord , 

DisplayElement  =$■  Display  StepRecord ,  "<"  =>  ComparelD); 
use  InputListl ; 
subtype  InputList  is  InputListl  .List] 

See  also  sections  17,  18,  19,  20,  21,  and  22. 
This  code  is  used  in  section  12. 

17.  Here  I  instantiate  a  list  type  to  manipulate  StepRecord  types,  but  to  restore  deletions, 
in  case  the  recursive  procedure  Branch AndBound  needs  to  back  out  changes. 

(Instantiate  generics  16)  +  = 

package  DeletedlnputListl  is  new  Generic  Jist(ElementType  =>  StepRecord , 
DisplayElement  =>  Display  Step  Record  ,"<"  =^  CompareRecursionLevel)\ 
use  DeletedlnputListl ; 
subtype  DeletedlnputList  is  DeletedlnputListl  .List; 


23 


SCHEDULE  TOOLS  APPENDIX  A         §18 

18.  Here  I  instantiate  a  list  type  to  manipulate  StepRecord  types  for  the  ReadyQueue , 
which  requires  that  the  records  be  sorted  in  Deadline  first  order. 

(Instantiate  generics  16)  += 

package  ReadyListl   is  new  Generic  Jist(ElementType  =>  StepRecord , 

Display  Element  =>  Display  Step  Record  ,"<"  =$>  CompareDeadline  ,"="  =>  IsEqual); 
use  ReadyListl  ; 
subtype  ReadyList  is  ReadyListl  .List; 

19.  Here  I  instantiate  a  list  type  to  manipulate  StepRecord  types  for  deletions  to  the 
ReadyQueue ,  which  requires  that  the  records  be  sorted  in  Recur  sionLev  el  first  order. 

(Instantiate  generics  16)  += 

package  DeletedReadyListl  is  new  Generic Jist(ElementType  =4>  StepRecord , 
Display  Element  =>  Display  Step  Record  ,"<*'  =$>  CompareRecur sionLev el); 
use  DeletedReadyListl  ; 
subtype  DeletedReadyList  is  DeletedReadyListl  .List; 

20.  Here  I  instantiate  a  list  type  to  manipulate  StepRecord  types  for  additions  to  the 
ReadyQueue ,  which  requires  that  the  records  be  sorted  in  RecursionLevel  first  order. 

( Instantiate  generics  16  )  += 

package  AddedReadyListl   is  new  Generic Jist(ElementType  =>  StepRecord , 

Display  Element  =>  Display  StepRecord  ,"<"  =$>  CompareRecur  sionLev  el); 
use  AddedReadyListl  ; 
subtype  AddedReadyList  is  AddedReadyListl  .List; 

21.  Here  I  instantiate  a  list  type  to  manipulate  StepRecord  types  for  the  ReadyQueue , 
which  requires  that  the  records  be  sorted  in  Deadline  first  order. 

( Instantiate  generics  16  )  += 

package  ScheduleListl  is  new  Generic Jist(ElementType  =>  ScheduleRecord , 
DisplayElement  =>  Display  ScheduleRecord  ,"<"  =s>  CompareStartTime); 
use  ScheduleListl  ; 
subtype  ScheduleList  is  ScheduleListl  .List; 

22.  Here  I  instantiate  a  list  type  to  manipulate  StepRecord  types  for  the  ReadyQueue , 
which  requires  that  the  records  be  sorted  in  Deadline  first  order. 

( Instantiate  generics  16  )  -f = 

package  CalendarListl  is  new  GenericJist(ElementType  =>  C alendar Record , 
DisplayElement  =>  Display  Calendar  Record  ,"<"  =>  CompareStartTime); 
use  CalendarListl ; 
subtype  CalendarList  is  CalendarListl  .List; 
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23.  Made  global  and  visible. 

(  Specification  of  types  and  variables  visible  from  schedtools   23 )  = 

maxjrecursion  :  natural  <—  0; 

recursion^level  :  natural  <—  0; 
See  also  sections  24,  25,  33,  and  59. 
This  code  is  used  in  section  12. 

24.  When  the  laxity  of  the  input  schedule  is  "tight,"  it  may  be  impossible  to  find  a 
schedule.  (Finding  a  schedule  is,  after  all,  an  NP-Complete  problem.)  In  this  case  the 
routine  will  give  up  after  some  amount  of  effort.  In  this  implementation,  I  give  up  if  the 
number  of  "backtracks"  is  FeasFactor  times  the  total  of  number  of  tasks  to  be  scheduled. 
If  this  number  is  exceeded  then  the  exception  NoFeasibleScheduleFound  is  thrown. 

(  Specification  of  types  and  variables  visible  from  schedtools   23 )  += 
NoFeasibleScheduleFound  :  Exception] 
FeasFactor  :  natural  <—  10; 

25.  Made  global  and  visible. 

( Specification  of  types  and  variables  visible  from  schedtools   23 )  += 
StepList  :  InputList ; 
ReadyQueue  :  Ready List; 
DeletedReady Queue  :  DeletedReadyList; 
DeletedlnputQueue  :  DeletedlnputList; 
AddedReady  Queue  :  AddedReadyList ; 
Schedule  :  ScheduleList; 
Calendar  :  CalendarList; 
FinalSchedule  :  ScheduleList; 

26.  Print  all  the  records  in  the  Step  list. 

{  Specification  of  procedures  visible  from  schedtools  26  )  = 

procedure  Print AllStep Records  (L  :  in  InputList); 
See  also  sections  27,  28,  29,  30,  31,  32,  34,  35,  36,  37,  38,  and  39. 
This  code  is  used  in  section  12. 

27.  Print  all  the  records  in  the  Step  fist. 

(  Specification  of  procedures  visible  from  schedtools   26  )  += 
procedure  Print AUStepRecords (L  :  in  ReadyList); 

28.  Print  all  the  records  in  the  Schedule  list. 

(  Specification  of  procedures  visible  from  schedtools   26  )  += 
procedure  Print AUSchedule Records (L  :  in  ScheduleList); 
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29.  Print  all  the  records  in  the  Schedule  list. 

(  Specification  of  procedures  visible  from  schedtools   26  )  += 
procedure  PrintAUCalendarRecords(L  :  in  out  ScheduleList); 

30.  Print  all  the  records  in  the  Schedule  list. 

{  Specification  of  procedures  visible  from  schedtools  26  )  += 
procedure  SaveAUScheduleRecords  (L  :  in  out  ScheduleList); 

31.  Creating  new  step  from  a  file  and  linking  it  to  the  step  list. 

(  Specification  of  procedures  visible  from  schedtools   26  )  +  = 
procedure  CreateNewStepList(L  :  in  out  InputList); 

32. 

(  Specification  of  procedures  visible  from  schedtools   26  )  += 

Procedure   CreateDeadlineFirstSchedule  (mr  :  in  out  natural;  num -developers  :  natural); 

33. 

( Specification  of  types  and  variables  visible  from  schedtools   23 )  += 
type  DesignerMatrix  is  array  (POSITIVE  range  <>)  of  natural; 

34.      Creating  a  new  schedule  record 

(  Specification  of  procedures  visible  from  schedtools  26  )  += 

procedure  CreateScheduleRecord(Rec   :  out  Schedule  Record;  S-ID  :  in 
natural;  TIME  1    :  in  natural;  TIME 2    :  in  natural;  S-LEVEL  :  in 
cap-map. map;  Developer  :  in  ustring); 

35. 

(  Specification  of  procedures  visible  from  schedtools   26  )  ■+-= 

procedure  LevelMinmum(MATRIX   :  in  DesignerMatrix;  LEVEL  :  in 
cap -map. map;  J  :  in  out  natural); 

36.      checking  the  in^degree   of  the  successors  of  the  assigned  step.     This  works  with 
deadline  heuristic 

(  Specification  of  procedures  visible  from  schedtools   26  )  += 

procedure  CheckInDegree(Rec  :  in  StepRecord;  Queue  :  in  out  ReadyList;InList  :  in 
out  InputList ;  finish-t  :  in  natural); 

37. 

(  Specification  of  procedures  visible  from  schedtools   26  )  += 

procedure  Strongly  Feasible  [Queue   :  in  out  Ready  List ;  MATRIX   :  in 
DesignerMatrix;  FEASIBLE  :  in  out  boolean); 
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38.      Assign  a  step  to  a  designer  according  to  its  deadline  and  its  expertise  level 

(  Specification  of  procedures  visible  from  schedtools   26  )  -f-= 

procedure  AssignStep (Current  :  StepRecord ;  MATRIX  :  in  out  Designer  Matrix] 
Sch  :  in  out  ScheduleList]  Finish  :  in  out  natural]  FEAS  :  out  boolean)] 

39. 

(  Specification  of  procedures  visible  from  schedtools   26  )  -f-= 

procedure  BranchAndBound(S-List  :  in  out  InputList;  R- Queue  :  in  out  ReadyList] 
FSched  :  in  out  ScheduleList]  MATRIX  :  in  Designer  Matrix;  Found  :  in  out 
BOOLEAN); 
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40.  Schedule  Tools  Body. 

41.  Global  variable  used  to  identify  different  tasks. 

(  Variables  local  to  schedtools   41 )  = 

StepID  :  natural  <—  1; 

data-file ,  data2-file  :  file-type ; 

FOUND  :  boolean  +-  FALSE; 

FEASIBLE  :  boolean  <-  TRUE; 

debug  :  boolean  <—  false; 

debug2  :  boolean  <—  false; 

StartTime  :  Time; 

dailyhours  :  WorkHours  <—  (ConvertHoursToDuration(S),  ConvertHoursToDuration(8), 
ConvertHours  ToDuration  (8),  ConvertHours  ToDuration  (8), 
ConvertHours  ToDuration  (8)); 

NRaD  :  boolean  <—  false; 
See  also  sections  55  and  56. 
This  code  is  used  in  section  12. 

42.  Print  all  the  records  in  the  STEP  list. 

(  Procedures  and  Tasks  in  schedtools  42  )  = 

procedure  PrintAUStep Records  {L  :  in  InputList)  is 

begin 

StepRecordHeading;  Display  (L); 

end  PrintAUStep  Records ; 
See  also  sections  43,  44,  45,  47,  49,  52,  53,  57,  58,  62,  66,  70,  and  71. 
This  code  is  used  in  section  12. 

43.  Print  all  the  records  in  the  STEP  list. 

(  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  Print AllStep Records (L  :  in  ReadyList)  is 
begin 

StepRecordHeading ;  Display  (L); 
end  PrintAUStep  Records ; 

44.  Print  all  the  records  in  the  STEP  list. 

(  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  Print AUScheduleRecords (L  :  in  ScheduleList)  is 
begin 

Schedule RecordHeading ;  Display  (L); 
end  Print  AUScheduleRecords; 
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45.      Print  all  the  records  in  the  STEP  list. 

{  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  SaveAUScheduleRecords  (L  :  in  out  ScheduleList)  is 
input  :  Ustring; 
size  :  natural; 
cur  :  ScheduleRecord ; 
begin 

(  Get  output  file  name  46  ) 

put-line ("Openinguyouruoutputuf  ile.  ");   create (data2- file ,  out_file ,  S(input)); 
size  <—  ListSize(L);  rewind(L)\ 
for  i  £  1  . .  size  loop 
if  i  =  1  then 

getCurrent(L,  cur); 
else 

getNext(L,  cur)] 
end  if; 

Save  ScheduleRecord  (cur ,  data2-file); 
end  loop; 
end  SaveAUScheduleRecords ; 

46. 

( Get  output  file  name  46 )  = 

puL/me(MPleaseuEnteruOutputuFile|jName:u");  getJine (input); 
This  code  is  used  in  section  45. 

47.      Print  all  the  records  in  the  STEP  list. 

(  Procedures  and  Tasks  in  schedtools  42 )  += 

procedure  Print AUCalendar Records (L  :  in  out  ScheduleList)  is 

size  :  natural; 

cur  :  ScheduleRecord ; 

cal  :  Calendar  Record ; 

dur  :  Duration; 
begin 

CalendarRecordHeading ; 

(Convert  ScheduleList  to  CalendarList  48) Display (Calendar); 
end  Print  AUCalendar  Records  ; 
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48. 

( Convert  ScheduleList  to  Calendar  List  48 )  = 

MakeEmpty(Calendar);  size  *—  ListSize(L);  Rewind(L); 
for  i  £  1  . .  size  loop 
if  i  =  1  then 

GetCurrent(L,  cur)] 
else 

GetNext(L,  cur); 
end  if; 

(fur  <—  ConvertHoursToDuration(cur.StartTime); 

cal.StartTime  <—  DurationTo Calendar Time  (StartTime ,  dailyhours  ,  dur ,  NRaD ); 
rfur  <—  ConvertHoursToDuration(cur.FinishTime); 

cal  .Finishtime  <—  Durationto  Calendar  Time  (StartTime ,  dailyhours  ,  rfwr,  NRaD); 
cal.StepId  <—  cur.StepId;   cal. Designer  <—  cur  .Designer] 

cap_map  .assign(cal  .StepLevel,  cur  .Step  Lev  el);  InsertlnOrder  (Calendar ,  cal); 
end  loop; 
This  code  is  used  in  section  47. 
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49.      Creating  new  step  from  a  file. 

{  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  CreateNew Step  List  (L  :  in  out  InputList)  is 
sr  :  StepRecord ; 
input  :  U string; 
do. alternate  :  boolean  <—  false; 
( Variables  local  to  CreateNewStepList  51 ) 
begin 

Mak  eEmp  ty(L); 
Step  Id  <—  1; 

putJine  ("PleaseuEnteruuINPUTuFILEuNAMEu"); 
get-line  (input); 

puL/me("Openinguyourudatauf ileuM); 
open  ( data-file ,  in. file ,  S(  input ) ) ; 
while  -iend-of-  file  (data,  file)  loop 
sr.  Step  Id  <—  Step  ID; 
if  do. alternate  then 

DeadTime  <—  get.date (data. file); 
else 

nat-io  .get(data.file ,  sr  .Deadline); 
end  if; 

nat.io  .get  ( data.file ,  sr  .Priority); 
naLio  .get  ( data-file ,  sr  .EstimatedDuration); 
if  do-alternate  then 

Earlytime  <—  get.date (data-file); 
else 

nat-io  .get  (data. file ,  sr  .EarliestStartTime); 
end  if; 

getf.set  (data. file ,  sr  .Predecessors  ); 
g etf. set  (data. file ,  sr  .Successors ); 
declare 

yrcap  :  cap.map.map; 
begin 

get.capability  (data. file ,  yrcap );   cap.map .assign (sr  .ExpLevel ,  yrcap ); 
end; 

sr.InDegree  «—  nat.set. size  (sr  .Predecessors); 
if  do. alternate  then 

( Convert  calendar  times  to  absolute  times  50 ) 
else 

StartTime  <-  Tz'me_O/(1997,7,3,0.0); 
end  if; 

AddToEnd(L,sr);   StepID  <-  StepID  +  1; 
end  loop; 
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CLOSE(  data-file); 
end  CreateNewStepList; 

50. 

( Convert  calendar  times  to  absolute  times  50 )  = 

if  StepID  =  1  then 

StartTime  <—  Earlytime; 

end  if; 

dur  <—  Calendar  Time  ToDuration  (StartTime ,  dailyhours  ,  Deadtime ,  NRaD ); 

sr. Deadline  <—  ConvertDurationToHours(dur); 

dur  <—  CalendarTime  ToDuration  (StartTime ,  dailyhours  ,  EarlyTime ,  NRaD ); 

sr .EarliestStartTime  *—  ConvertDurationToHours(dur); 
This  code  is  used  in  section  49. 

51. 

(  Variables  local  to  CreateNewStepList  51 }  = 

<fur  :  Duration; 

EarlyTime , DeadTime  :  Time; 
This  code  is  used  in  section  49. 

52. 

(  Procedures  and  Tasks  in  schedtools   42  )  += 

procedure  RelnitializeMatrix  (MATRIX  :  in  out  Designer  Matrix)  is 
begin 

for  i  G  1  . .  matrix' length  loop 

matriz(t)  <—  0; 
end  loop; 
end  RelnitializeMatrix ; 
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53.  Creating  new  step. 

(  Procedures  and  Tasks  in  schedtools   42  )  += 

Procedure   CreateDeadlineFirstSchedule(mr  :  in  out  natural ;  num_developers  :  natural) 

is    Current  :  StepRecord; 
Feasible  :  boolean  «—  True; 
eat  :  designermatrix (1  ..  num^  developers); 
begin 

Kntr  <—  List  Size  (Step List);  (Initialize  the  lists  for  intensive  list-processing  54) 
Rewind  (StepList);    GetCurrent(StepList ,  Current)] 
for  i  E  1  . .  Kntr  loop 

if  Current  .InDegree  =  0  then 

DeleteCurrent(StepList);  InsertlnOrder (Ready Queue  ,  Current); 
if  i  <  Kntr  then 

GetCurrent(StepList ,  Current); 
end  if; 
else 

if  i  <  .fifra^r  then 

G etNext (Step List ,  Current); 
end  if; 
end  if; 
end  loop; 

Feasible  <—  True;   Found  <— False;  RelnitializeMatrix(EAT); 
Strongly  Feasible  (Ready  Queue  ,  EAT ,  Feasible); 
if  Feasible  then 

puLline  ("CallinguBranchAndBounduRoTitine. " ); 
Branch  AndBound  (StepList ,  Ready  Queue  ,  Schedule ,  EAT ,  FOUND); 
puLline ( "Returneduf  romuBranchAndBounduRout ine .  "  ); 
end  if; 
if  ^FOUND  then 

puLline  (MSORRYuTHEREuISuNOuFEASIBLEuSCHEDULEM); 
end  if; 

mr  <—  max-recursion ; 
end  CreateDeadlineFirstSchedule ; 

54.  If  this  is  not  the  first  time  this  routine  is  called  then  it  behooves  us  to  clean  up  the 
old  lists  from  previous  processing.  If  this  is  the  first  time,  no  harm  done. 

{ Initialize  the  lists  for  intensive  list-processing  54 )  = 

MakeEmpty (Ready Queue  );  MakeEmpty (Schedule);  MakeEmpty (DeletedReady Queue); 

MakeEmpty(DeletedlnputQueue);   MakeEmpty (AddedReady Queue  ); 
This  code  is  used  in  section  53. 
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55. 

( Variables  local  to  schedtools   41 )  += 
kntr  :  integer  <—  0; 

56. 

( Variables  local  to  schedtools   41 )  += 

counter  :  natural  <—  0;  ®{.Used for  tracking  backtracking <8} 

57.      Creating  a  new  schedule  record 

(  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  CreateScheduleRecord(Rec   :  out  Schedule  Record;  S-ID   :  in 
natural]  TIME  1   :  in  natural;  TIME 2   :  in  natural;  S-LEVEL  :  in 
cap-map  .map ;  Developer  :  in  ustring)  is 
begin 

Rec.StepID  <-  S_ID;  Rec.StartTime  <-  TIME1;  Rec .FinishTime  <-  TIME2; 
Rec. Designer  <—  Developer;  cap_map .assign(Rec  .StepLevel,  S-LEVEL); 
end  Create  Schedule  Record ; 

58. 

(  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  LevelMinmum(MATRIX   :  in  Designer  Matrix;  LEVEL  :  in 
cap -map  .map ;  J  :  in  out  natural)  is 
rnin  :  naturaZ; 
n  :  natural; 
begin 

j  <—  0;  rnin  «—  natural' last;  n  *—  1; 
if  is_ qualified  (level ,n)  then 
J  «—  1;   nim  «—  ma£riz(l); 
end  if; 

for  m  G  2  . .  matrix' length  loop 
if  ma£riz(m)  <  mm  then 
if  is_ qualified  (lev el  ,m)  then 
mm  <—  matrix  (m);  j  *—  m; 
end  if; 
end  if; 
end  loop; 
if  j  =  0  then 

raise  noqualifieddevelopers  ; 
end  if; 
end  levelminmum; 
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59. 

(  Specification  of  types  and  variables  visible  from  schedtools   23  )  += 
noqualifieddevelopers  :  exception; 
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60.  Check  In  Degree.  Checking  the  in^degree  of  the  successors  of  the  assigned  step. 
This  works  with  deadline  heuristic 

61.  Presently  changes  the  start-time  of  any  successors.  Will  need  to  modify  when  I 
convert  the  updates  from  a  recursive  local  variable  to  a  global  one.  Also  deletes  a  scheduled 
task  from  the  INPUT-LIST .  Then  it  updates  the  queue  of  "ready"  tasks. 


^TX 


Precedence  Graph 
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62.  This  procedure  loops  through  the  entire  InputList  finding  the  successors  of  Rec. 
Once  found  it  updates  the  EarliestStartTime .  Also,  if  the  InDegree  reaches  zero  this 
means  it  no  longer  is  waiting  on  a  predessor  to  be  scheduled,  it  is  "ready"  to  be  sceduled — 
that  is,  moved  from  the  InputList  to  the  ReadyQueue . 

Note:  It  appears  that  the  Predecessor  field  of  the  StepRecord  is  ignored.  Only  the 
successor  field  is  used. 

(Procedures  and  Tasks  in  schedtools  42)  += 

procedure  ChecklnD  egree(Rec  :  in  StepRecord;  Queue  :  in  out  ReadyList ; InList  :  in 
out  InputList ;  finish-t  :  in  natural)  is 
Current  :  StepRecord; 
t  :  natset .set  <—  Rec. Successors; 
k,  kntr  :  natural; 
FOUND  :  boolean  <-  FALSE; 
deleted  :  boolean  <— false; 
begin 

if  natset .size(t)  ^  0  then 

Rewind  (InList);   kntr  <—  ListSize  (InList);   GetCurrent(InList ,  Current); 
for  i  €  1  . .  kntr  loop 
k  <—  Current  .Stepld; 
if  natset. member (k,t)  then 

if  Current. EarliestStartTime  <  finish-t  then 

Current .EarliestStarttime  *—  finishA; 
end  if; 

Current. InDegree  <—  Current  .InDegree  —  1; 
if  Current. InDegree  —  0  then 

( Move  record  from  input  list  to  ready  list  64 ) 
else 

Update  Current  (InList ,  Current); 
end  if; 
end  if; 

( Get  next  record  63 ) 
end  loop; 
end  if; 
end  ChecklnDegree; 
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63. 

(  Get  next  record  63 )  = 
if  i  <  kntr  then 
if  deleted  then 

GetCurrent(InList,  Current);   deleted  <—  false; 
else 

GetNext(InList ,  Current); 
end  if; 
end  if; 

This  code  is  used  in  section  62. 

64. 

( Move  record  from  input  list  to  ready  list  64 )  = 

Delete  Current(InList);    Current .recursionlevel  <—  recursion-level; 

Ins ertlnOrder (Queue,  Current);  InsertlnOrder (AddedReady Queue  ,  Current); 

Current. InDegree  <—  Current .Indegree  +  1; 

InsertlnOrder (DeletedlnputQueue,  Current);   deleted  <—  true; 

if  debug  then 

puL/me("MovinguRecordutouDeletedInputQueue.");  Display (DeletedlnputQueue); 
end  if; 

This  code  is  used  in  section  62. 
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65.      StrongFeasible.      Checking  the  feasibility  of  the  schedule  with  each  step  in  the 
ready  queue. 
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66.  Definition:  A  partial  feasible  schedule  is  said  to  be  strongly-feasible  if  all  the 
schedules  obtained  by  extending  the  current  schedule  with  any  one  of  the  remaining  tasks 
are  also  feasible.  Thus,  if  a  partial  feasible  schedule  is  found  not  to  be  strongle-feasible 
because,  say,  task  T  misses  its  deadline  when  the  current  schedule  is  extended  by  T,  then 
it  is  appropriate  to  stop  the  search  since  none  of  the  future  extensions  involving  task  T 
will  meet  its  deadline.  In  this  case,  a  set  of  tasks  can  not  be  scheduled  given  the  current 
partial  schedule.  (In  the  terminology  of  branch-and-bound  techniques,  the  search  path 
represented  by  the  current  partial  schedule  is  bound  since  it  will  not  lead  to  a  feasible 
complete  schedule.) 

(  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  Strongly  Feasible  {Queue  :  in  out  ReadyList;  MATRIX  :  in 
DesignerMatrix; feasible  :  in  out  boolean)  is 
temp  :  natural; 
J  :  natural  <—  1; 
L  :  natural  <—  1; 
min  :  natural  <—  0; 
kntr  :  natural  <—  0; 
myonum  :  natural  <—  0; 
Current  :  StepRecord] 
MyopicNum  :  constant  natural  <—  7; 
begin 

if  debug  then 

puLZme("StronglyFeasible>uStartu"); 
end  if; 

feasible  <—  True]   kntr  <—  ListSize  {Queue);   (Compute  myopic  number  67) 
Rewind  ( Queue ); 
for  t£  1  ..  myonum  loop 
if  -> feasible  then 

exit; 
end  if; 
if  i  =  1  then 

G et Current ( Q ueue ,  Current)] 
else 

GetNext{Queue ,  Current); 
end  if; 

LevelMinmum(MATRIX ,  Current.  ExpLevel,  J);  min  «-  MATRIX  (J); 
(  Debug  code  set  1  68  ) 
if  min  >  Current. EarliestStartTime  then 

temp  < —  min; 
else 

temp  «—  Current .EarliestStarttime; 
end  if; 
temp  «—  temp  +  Current. EstimatedDuration;   (Debug  code  set  2  69) 

40 


§66       APPENDIX  A  STRONGFEASIBLE 

if  temp  >  Current  .Deadline  then 

feasible  <—  False; 
end  if; 
end  loop; 
end  Strongly  Feasible ; 

67.      Without  this  tidbit  of  code,  the  algorithm  goes  from  order  n  to  order  n2 . 

(  Compute  myopic  number  67 )  = 
if  kntr  >  Myopic-Num  then 

myonum  <—  Myopic-Num; 
else 

myonum  <—  kntr; 
end  if; 

This  code  is  used  in  section  66. 

68. 

( Debug  code  set  1  68 )  = 
if  debug  then 

pu2("StronglyFeasible>uIdu=un);   naLio .put (Current. Stepld ,  1); 

pw<("uuminu=u");   naLio  .put  (min ,  2);  put(n  .uCurrent . Earliest StaxtTimeuu=u" ); 

naLio .put (Current .EarliestStartTime ,2);  putJine("  .u")? 
end  if; 

This  code  is  used  in  section  66. 

69. 

( Debug  code  set  2  69 )  = 
if  debug  then 

pui("StronglyFeasible>uM);  naLio. put (i, 2);  put ("  .utempu=uM); 
naLio  .put (temp  ,2);  put  ("  .uuCurrent  .Deadlineu=u"); 
naLio .put(Current .Deadline  ,2);  puLline("  .u")', 
end  if; 
This  code  is  used  in  section  66. 
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70.      AssignStep.      Assign  a  step  to  a  designer  according  to  its  deadline  and  its  expertise 
level:  BRANCH  AND  BOUND  CASE 

(  Procedures  and  Tasks  in  schedtools  42  )  += 

procedure  AssignStep  (Current   :  in  StepRecord;  MATRIX   :  in  out 

Designer  Matrix;  Sch  :  in  out  ScheduleList;  Finish  :  in  out  natural]  FE AS  :  out 
boolean)  is 
J  :  natural; 
MIN  :  natural] 
temp  :  natural  <—  0; 
tempi  :  StepRecord  <—  Current; 
Dummy  :  ScheduleRecord ; 
begin 

LevelMinmum(MATRIX ,  Current.  ExpLevel,  J);  MIN  <-  MATRIX  (J); 
if  MIN  <  Current .EarliestStartTime  then 

temp  <—  Current  .EarliestStartTime;  finish  <—  temp  +  Current  .EstimatedDuration; 
if  finish  >  Current. DEADLINE  then 

FEAS  <-  FALSE; 
else 

FEAS  <-  TRUE;  MATRIX  (J)  <-  finish;   Create  ScheduleRecord  (Dummy, 
tempi  .StepID ,  temp,  finish,  tempi  .ExpLevel , geLdeveloper^name (j)); 
Add  ToEnd  (Sch,  Dummy ) ; 
end  if; 
else 

temp  <—  MIN;  finish  <—  temp  -f  Current. EstimatedDuration; 
if  finish  >  Current. Deadline  then 

1^45  <-  FALSE; 
else 

F£4S  <-  TRUE;  MATRIX  (J)  ^finish;   Create  ScheduleRecord  (Dummy, 
tempi  .StepID ,  temp,  finish,  tempi  .ExpLevel , geLdeveloper^name (j)); 
AddToEnd  ( Sch ,  Dummy ) ; 
end  if; 
end  if; 
end  AssignStep; 
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71.      Branch  And  Bound. 

( Procedures  and  Tasks  in  schedtools   42  )  += 

procedure  Branch AndBound (S-List  :  in  out  InputList;  R-Queue  :  in  out  ReadyList ; 
FSched  :  in  out  ScheduleList;  MATRIX  :  in  DesignerMatrix;  Found  :  in  out 
BOOLEAN)  is 
( Variables  local  to  Branch  AndBound  73  ) 
begin 

(  Update  some  recursion  stuff  72  ) 
if  IsEmpty (iL Queue)  then 
if  do-verbose  then 

ScheduleRecordHeading  ;  Print AUScheduleRecords  (FSched);  newJine; 
end  if; 

put ( MBacktrackingu :=UM);   tesLio-pkg .put ( counter);  newJine ; 
®{.Copy(F-Sched,FinalSchedule);  <a"}Found  <—  True; 
if  debug  then 

put-line  ("Founduauvaliduschedule .  " ); 
end  if; 
elsif  -ifound  then 

OrigSize  <—  ListSize(R^Queue); 
for  i  INI  . .  OrigSize  loop 

(  Update  backtrack  counter  74  ) 

( Copy  linked  lists  and  the  designer  matrix  onto  the  stack  80 ) 

( Get  appropriate  iL  Queue  record  76  ) 

if  debug  then 

pM<(MBranchAndBouiid>ljCiirreiitu=u" );  Display  Step  Record  ( Current); 
put  ("BranchAndBound>uList Size (R_Queue)uisuM); 
naLio  .put  (ListSize  (iL  Queue ));  putJine  ( "  .  u" ); 
end  if; 

AssignStep  (  Current ,  MAT ,  FSched ,  FinishTime ,  Feasible ); 
ChecklnDegree  ( Current ,  iL  Queue ,  S-List ,  FinishTime ); 
( Delete  appropriate  iL  Qweue  record  78  ) 
if  debug  then 

puLline ("Afteruassigningustep,ubutubeforeut est inguf  or uFeasibility :  '|); 
Print AUStepRecords (iL Queue);  PrintAUScheduleRecords(F^Sched); 
end  if; 

Strongly  Feasible  (iL  Queue ,  MAT ,  Feasiblel ); 
if  Feasiblel  then 

Branch  AndBound  (S-List ,  R_Queue ,  FSched ,  MAT ,  Found); 
( Update  recursion  stuff  again  79  ) 
end  if; 

(  Free  up  local  linked  lists  83  ) 
if  Found  then 
exit; 
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end  if; 
end  loop; 

if  recursion-level  <  1  then 
if  debug  then 

j)ML/me("BrajichAndBound>uFinisheduunwindingutheustack . "); 
end  if; 
end  if; 
end  if; 
end  Branch AndBound ; 

72. 

(  Update  some  recursion  stuff  72  )  = 

if  (diag-sched  V  diagstep  V  diag-ready-queue)  then 

do-verbose  *—  true; 
end  if; 

recursion-level  <—  recursion-level  +  1; 
if  recursion- lev  el  >  max-recursion  then 

max-recursion  +—  recursion-level; 
end  if; 

This  code  is  used  in  section  71. 

73. 

( Variables  local  to  Branch  AndBound  73 )  = 

do-verbose  :  boolean  <— false; 

OrigSize  :  natural; 
See  also  sections  75,  77,  82,  85,  88,  and  90. 
This  code  is  used  in  section  71. 

74. 

( Update  backtrack  counter  74  )  = 
if  i  ^  1  then 

counter  <—  counter  +  1; 
end  if; 

TotSize  <—  ListSize(R_ Queue)  -f  ListSize(S-List)  +  ListSize (F-Sched); 
if  counter  >  (FeasFactor  *  TotSize)  then 

raise  NoFeasibleScheduleFound ; 
end  if; 
This  code  is  used  in  section  71. 

75. 

(Variables  local  to  Branch  AndBound  73)  += 
TotSize  :  natural; 
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76. 

(Get  appropriate  R-Queue  record  76)  = 

appropriate  «—  i  —  (OrigSize  —  ListSize  (R-Queue)); 
if  debug  then 

pu<("BranchAndBoinid>uGettingunumberLi");  naLio  .put  (Appropriate  ,1); 
pu2("urecorduinuReadyuQueu.e.  ");  put(n(iu=un);   naLio  .put(i,  1); 
pu£("  ,u0rigsizeu=uM);   naLio  .put  (Origsize ,  1);  puLline(n)  .  "); 
end  if; 

GetNth(R- Queue ,  appropriate ,  Current ); 
This  code  is  used  in  section  71. 

77. 

(Variables  local  to  Branch AndBound  73)  += 
appropriate  :  natural; 

78. 

(Delete  appropriate  R-Queue  record  78)  = 

if  debug  then 

putJine  ( "Delet inguappropriat euR_Queueurecord . " ); 

end  if; 

G etNth(R- Queue ,  appropriate ,  Current);  Delete  Current(R- Queue); 

Current  .Recur sionLev el  <—  Recursion. Level; 

InsertlnOrder (DeletedReady Queue ,  Current); 

if  debug  then 

puLline ("FinishedudeletinguappropriateuR_Queueurecord. "); 

end  if; 
This  code  is  used  in  section  71. 

79. 

( Update  recursion  stuff  again  79  )  = 

recursion-level  «—  recursion-level  —  1; 
This  code  is  used  in  section  71. 

80.      As  far  as  I  can  see  the  step  list  is  never  modified,  so  why  is  it  copied?    Aha!   It  is 
modified  in  procedure  check-in-degree . 

( Copy  linked  lists  and  the  designer  matrix  onto  the  stack  80 )  = 
( Do  diagnostics  81 ) 

<&{.Copy(S-List,InList);    Copy(R-Queue,  Queue);    Copy(F-Sched,  Sched); 
^y MAT  *-  MATRIX; 

This  code  is  used  in  section  71. 
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81. 

(  Do  diagnostics  81 )  = 
if  do-verbose  then 

puL/me(M=======================================================M); 

pti<("Recursionuleveluisu");   naLio .put (recursion-level);  putAine("  .u")j 
end  if; 
if  diagstep  then 

Print  AllStep  Records  (S-List); 
end  if; 
if  diag- ready_ queue  then 

Print  AllStep  Records  (R_QUEUE); 
end  if; 
if  diagsched  then 

Print  AUS  cheduleRecords  (Fsched); 
end  if; 

This  code  is  used  in  section  80. 

82. 

(Variables  local  to  Branch AndBound  73)  += 
diagstep  :  boolean  <—  false] 
diag^ready- queue  :  boolean  <— false; 
diagsched  :  boolean  «—  false; 

83. 

( Free  up  local  linked  lists  83 )  = 

Q{.MakeEmpty(InList);  MakeEmpty (Queue);  MakeEmpty(Sched); 
G}(  Restore  R-Queue  84) 
{ Restore  S-List  86 ) 
( Restore  FSched  89  ) 

This  code  is  used  in  section  71. 
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84. 

(Restore  R-Queue  84)  = 
if  -'Found  then 
if  debug  then 

pML/me(MRestoringuR_Queue. "); 
end  if; 

Dsize  <—  ListSize(AddedReady Queue); 
if  Dsize  ^  0  then 

GetNth(AddedReady  Queue  ,  Dsize ,  Current); 
while  Current  .recur sionlev el  —  recursion-level  loop 
Delete  Current(AddedReady  Queue); 
D eleteMatching(R- Queue ,  Current,  Success); 
if  debug  then 

^M^'Deletingurecordu");  puL/ine("FromuReadyQueue. "); 
Display  StepRecord  ( Current); 
end  if; 
if  — 'Success  then 

put-Line  ("Didunotuf  indumatchingurecord! "); 
end  if; 

Dsize  <—  ListSize(AddedReady  Queue); 
if  Dsize  —  0  then 

exit; 
else 

GetNth(AddedReady  Queue  ,  Dsize ,  Current); 
end  if; 
end  loop; 
end  if; 

Dsize  <—  ListSize(DeletedReady  Queue); 

GetNth(DeletedReady Queue ,  Dsize ,  Current);  Delete Current(DeletedReady Queue  ); 
InsertInOrder(R_ Queue,  Current);   (  Reset  InDegree  87) 
if  debug  then 

puL/me(MFinishedurestoringuR_Queue. "); 
end  if; 
end  if; 
This  code  is  used  in  section  83. 

85. 

(Variables  local  to  Branch AndBound   73)  += 
Success  :  boolean ; 
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86. 

( Restore  S-List  86 )  = 
if  -iFound  then 

Dsize  <—  ListSize(DeletedlnputQueue)] 
if  Dsize  ^  0  then 

GetNth(DeletedInputQueue , Dsize ,  Current)] 

■while  Current  .recur sionlevel  =  recursion-level  loop 

Delete  Current(DeletedlnputQueue)]  InsertlnOrder (S-List ,  Current)] 

( Reset  InDegree  87) 

Dsize  <r—  ListSize(DeletedlnputQueue)] 

if  Dsize  ^  0  then 

GetNth(DeletedInputQueue ,  Dsize ,  Current ); 
else 

exit; 
end  if; 
end  loop; 
end  if; 
end  if; 
This  code  is  used  in  section  83. 
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87. 

(  Reset  InDegree   87 )  = 
if  debug  then 

pu<("ResettinguInDegreeuforusuccessorsuofu:u");  DisplayStepRecord (Current); 
end  if; 

Dsize  <—  ListSize(S-List);  t  «—  Current  .Successors ;  Rewind  (S- List); 
for  i  £  1  . .  .Djize  loop 
if  i  —  1  then 

GetCurrent(S-List ,  Current); 
else 

GetNext(S-List ,  Current); 
end  if; 

fc  <—  Current  .Stepld; 
if  debug  then 

pu£ ( "St epldu=u" );  pu£ (fc);  pu£ ( "  .  uuNowucheckinguf  orumembership . " ); 
end  if; 

if  naLset  .member (k,t)  then 
if  debug  then 

puLline("  (Member)  " );   Display  Step  Record  ( Current); 
end  if; 

Current. InDegree  <—  Current. InDegree  +1;    Update  Current  (S-List,  Current); 
if  debug  then 

Display  Step  Record  ( Current ); 
end  if; 
else 

if  debug  then 

put-line  ( "  (NotuMember)  "); 
end  if; 
end  if; 
end  loop; 
This  code  is  used  in  sections  84  and  86. 

88. 

(Variables  local  to  Branch AndBound   73)  += 
<  :  natset .set; 
k  :  natural; 
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89. 

(  Restore  F.Sched  89 )  = 
if  -iFound  then 
if  debug  then 

jmL/ine  ("RestoringuF_Sched. "); 
end  if; 

Dsize  <—  ListSize(FSched);   GetNth(F-Sched,  Dsize,  D  Current); 
DeleteCurrent(F-Sched); 
if  debug  then 

puLline (MFinishedurestoringuF_Sched. "); 
end  if; 
end  if; 

This  code  is  used  in  section  83. 

90. 

(  Variables  local  to  Branch AndBound  73  )  += 
InList  :  InputList; 
D  Current  :  S cheduleRecord ; 
®{.Queue  :  ReadyList; 
Sched  :  ScheduleList; 
<8} Dsize  :  natural] 
Current  :  StepRecord] 

MAT  :  De signer Matrix{\  ..  matrix' length); 
Feasible  :  BOOLEAN  «-  TRUE; 
Feasiblel  :  BOOLEAN  <-  TRUE; 
FinishTime  :  natural  <—  0; 
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91.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

92.  I  enclose  the  RCS  Keywords  here  as  well,  since  that  is  how  I  keep  track  of  versions. 

$RCSfile:  schedtools.aweb,v 

$  Revision:  1.5 

$Date:  1997/08/24  22:27:29 

$Author:  evansjr 

$Id:  schedtools.aweb,v  1.5  1997/08/24  22:27:29  evansjr  Exp  evansjr 

$Locker:  evansjr 
$State:  Exp 
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93.  Index.  Here  is  a  cross-reference  table  for  the  schedtools  package.  All  modules 
in  which  an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are 
indexed  only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers 
in  module  names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  corre- 
spond to  sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond 
to  the  section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


Ada:     12. 

AddedReadyList :     20,  25. 

AddedReadyListl  :     20. 

AddedReady Queue :     25,  54,  64,  84. 

AddToEnd:     49,  70. 

appropriate :     76-78. 

Appropriate :     76. 

assign:     48-49,  57. 

AssignStep:     38,  70,  71. 

backtracking:     56. 

boolean:     37-38,  41,  49,  53,  62,  66,  70, 

73,  82,  85. 
BOOLEAN:     39,  71,  90. 
Branch AndBound :     17,  39,  53,  71. 
cal:     47-48. 
Calendar:     25,  47-48. 
calendar:     12. 
CalendarList:     22,  25. 
CalendarListl  :     22. 
CalendarRecord :     22,  47. 
Calendar 'RecordHeading :     47. 
Calendar 'TimeToDuration:     50. 
calyr:     12. 

cap_map:     34-35,  48-49,  57-58. 
capability :     12. 
check An_degree:     80. 
ChecklnDegree:     36,  62,  71. 
CLOSE:     49. 
CompareDeadline :     18. 
ComparelD :     16. 

C  ompare  Recur  sionLev  el:     17,  19-20. 
Compare  StartTime:     21-22. 
ConvertDurationToHours :     50. 
ConvertH our sTo Duration:     41,  48. 
Copy:     71,  80. 


counter:     56,  71,  74. 

create :     45. 

CreateDeadlineFirstSchedule:     32,  53. 

CreateNew Step  List:     31,  49. 

Create ScheduleRecord :     34,  57,  70. 

cur:     45,  47-48. 

Current:     38,  53,  62-64,  66,  68-71,  76, 

78,  84,  86-87,  90. 
dailyhours:     41,  48,  50. 
data-file:     41,  49. 
data2.file:     41,  45. 
D  Current:     89-90. 

Deadline:     18,  21-22,  49-50,  66,  69-70. 
DEADLINE:     70. 
DeadTime:     49,  51. 
Deadtime :     50. 
debug:     41,  64,  66,  68-69,  71,  76,  78, 

84,  87,  89. 
debugt:     41. 

DeleteCurrent:     53,  64,  78,  84,  86,  89. 
deleted:     62-64. 
DeletedlnputList:     17,  25. 
DeletedlnputListl :     17. 
Deletedlnput Queue:     25,  54,  64,  86. 
DeletedReadyList:     19,  25. 
DeletedReadyListl  :     19. 
DeletedReady Queue:     25,  54,  78,  84. 
Delete  Matching:     84. 
Designer:     48,  57. 
DesignerMatrix:     33,  35,  37-39,  52,  58, 

66,  70-71,  90. 
designermatrix :     53. 
Developer:     34,  57. 
diag_ready_ queue:     72,  81-82. 
diag.sched:     72,  81-82. 
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diagstep:     72,  81-82. 

Display:     42-44,  47,  64. 

Display  Calendar  Record:     22. 

Display  Element:     16-22. 

Display  ScheduleRecord:     21. 

Display  Step  Record  :     16-20,  71,  84,  87. 

do-alternate:     49. 

do-verbose:     71—73,  81. 

Dsize:     84,  86-87,  89-90. 

Dummy:     70. 

dur:     47-48,  50-51. 

Duration:     47,  51. 

DurationTo  Calendar  Time:     48. 

Durationto  Calendar  Time:     48. 

EarliestStarttime:     62,  66. 

EarliestStartTime:     49-50,  62,  66,  68,  70. 

Early  Time:     50-51. 

Earlytime:     49-50. 

ea< :     53. 

£4T:     53. 

ElementType:     16-22. 

end.of-fi.le:     49. 

EstimatedDuration:     49,  66,  70. 

Exception:     24. 

ExpLevel:     49,  66,  70. 

FSched:     39,  71,  74,  80,  89. 

F.sched:     81. 

FALSE:     41,  62,  70. 

False:     53,  66. 

/a/ae:     41,  49,  62-63,  73,  82. 

F£M5:     38,  70. 

FeasFactor:     24,  74. 

feasible :     66. 

FEASIBLE:     37,  41. 

Feasible:     53,  71,  90. 

Feasible  1:     71,  90. 

file-type:     41. 

FinalS chedule:     25,  71. 

Finish:     38,  70. 

finish:     70. 

finish-t:     36,  62. 

FinishTime:     48,  57,  71,  90. 

Finishtime:     48. 


found:     71. 

FOUND:     41,  53,  62. 

Foumf:     39,  53,  71,  84,  86,  89. 

Generic-list:     16-22. 

Generic-List:     12. 

generic-map-pkg:     12. 

genericset-pkg:     12. 

$e<:     49. 

g  et- capability :     49. 

get-date:     49. 

get-developer-name:     70. 

getAine:     46,  49. 

GetCurrent:     48,  53,  62-63,  66,  87. 

getCurrent:     45. 

getfset:     49. 

getNext:     45. 

GetNext:     48,  53,  63,  66,  87. 

Ge*M/i:     76,  78,  84,  86,  89. 

i:     45,  48,  52,  53,  62,  66,  71,  87. 

Z/\T:     71. 

in-degree:     36,  60. 

in-file:     49. 

InDegree:     49,  53,  62,  64,  87. 

Indegree :     64. 

7n£w*:     36,  62-64,  80,  83,  90. 

input:     45-46,  49. 

INPUT-LIST:     61. 

InputList:     16,  25-26,  31,  36,  39,  42, 

49,  62,  71,  90. 
InputListl :     16. 

InsertlnOrder :     48,  53,  64,  78,  84,  86. 
integer:     55. 
is-qualified:     58. 
IsEmpty:     71. 
IsEqual:     18. 
tfTi^r:     53. 

ifen*r:     55,  62-63,  66-67. 
/asf:     58. 

fentfta:     52,  58,  90. 
/eve/:     58. 
LEVEL:     35,  58. 
LevelMinmum:     35,  58,  66,  70. 
levelminmum:     58. 
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List:     16-22. 

ListSize:     45,  48,  53,  62,  66,  71,  74,  76, 

84,  86-87,  89. 
m:     58. 

MakeEmpty:     48-49,  54,  83. 
map:     34-35,  49,  57-58. 
MAT:     71,  80,  90. 
MATRIX:     35,  37-39,  52,  58,  66,  70- 

71,  80. 
matrix:     52,  58,  90. 
max-recursion :     23,  53,  72. 
member:     62,  87. 
min:     58,  66,  68. 
MIN:     70. 
mr:     32,  53. 
myonum:     66-67. 
MyopicNum:     66-67. 
naUo:     49,  68-69,  71,  76,  81. 
naLset:     49,  62,  87-88. 
natural:     23-24,  32-36,  38,  41,  45,  47,  53, 

56-58,  62,  66,  70,  73,  75,  77,  88,  90. 
new-line:     71. 

N o Feasible ScheduleFound:     24,  74. 
noqualifieddev elopers  :     58-59. 
NRaD:     41,  48,  50. 
num-dev elopers:     32,  53. 
open:     49. 

OrigSize:     71,  73,  76. 
Origsize :     76. 
out- file:     45. 
POSITIVE:     33. 
Predecessor :     62. 
Predecessors:     49. 
P Tint AllCalendar Records:     29,  47. 
Print AUS cheduleRecords  :     28,  44,  71,  81. 
Print AUStepRecords:     26,  27,  42,  43, 

71,  81. 
Priority:     49. 
Procedure :     32,  53. 
pu*:     68-69,  71,  76,  81,  84,  87. 
put-Line :     66,  84. 
put-line:     45-46,  49,  53,  64,  68-69,  71, 

76,  78,  81,  84,  87,  89. 


Queue:     36-37,62,64,66,80,83,90. 
R-QUEUE:     81. 

R.Queue:     39,71,74,76,78,80,84. 
ReadyList:     18,  25,  27,  36-37,  39,  43, 

62,  66,  71,  90. 
ReadyListl  :     18. 

ReadyQueue:     18-22,25,53-54,62. 
Rec:     34,  36,  57,  62. 
recursionJevel:     23,  64,  71-72,  79,  81, 

84,  86. 
Recursion-Level:     78. 
recursionlevel:     64,  84,  86. 
Recur sionLev el:     19-20,  78. 
Reinitialize  Matrix :     52,  53. 
Rewind:     48,  53,  62,  66,  87. 
rewind:     45. 
SJD:     34,  57. 
S-LEVEL:     34,  57. 
S-List:    39,  71,  74,  80-81,  86-87. 
Save  AUS  cheduleRecords  :     30,  45. 
SaveScheduleRecord :     45. 
Sch:     38,  70. 
Sched:     80,  83,  90. 
SchedPrims:     12. 
schedtools:     12. 
schedtools.adb  :      12. 
schedtools. ads  :     12. 
Schedule:     25,  53-54. 
ScheduleList:     21,  25,  28-30,  38-39, 

44-45,  47,  70-71,  90. 
ScheduleListl :     21. 

ScheduleRecord :     21 ,  34,  45,  47,  57,  70,  90. 
ScheduleRecordHeading :     44,  71. 
set:     62,  88. 
size:     45,  47-49,  62. 
sr:     49-50. 

StartTime:     41,  48-50,  57. 
StepID:     41,  49-50,  57,  70. 
Stepld:     48-49,  62,  68,  87. 
StepLevel:     48,  57. 
StepList:     25,  53. 
StepRecord:     16-22,  36,  38,  49,  53,  62, 

66,  70,  90. 
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StepRecordHeading :     42-43. 

Strongly  Feasible:     37,  53,  66,  71. 

Success :     84-85. 

Successors  :     49,  62,  87. 

system  dependencies:     91. 

temp:     66,  69-70. 

tempi :     70. 

tesLio-pkg:     12,  71. 

TexUO:     12. 

Time:     41,  51. 

Time.Of:     49. 

TIME1 :     34,  57. 

TIME2:     34,  57. 

TotSize :     74-75. 

tracking :     56. 

*rue:     64,  72. 

TRUE:     41,  70,  90. 

True:     53,  66,  71. 

Update  Current:     62,  87. 

Use:     12. 

Used:     56. 

ustring:     34,  57. 

U string:     45,  49. 

U strings :     12. 

ustring  s:     12. 

Wo  r  fciZo  wr  j  :     41. 

yrcap :     49. 
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Compute  myopic  number  67  )       Used  in  section  66. 

Convert  calendar  times  to  absolute  times  50 )     Used  in  section  49. 

Convert  ScheduleList  to  CalendarList  48 )     Used  in  section  47. 

Copy  linked  lists  and  the  designer  matrix  onto  the  stack  80  )     Used  in  section  71. 

Debug  code  set  1   68  )      Used  in  section  66. 

Debug  code  set  2  69  )      Used  in  section  66. 

Delete  appropriate  R^Queue  record  78)      Used  in  section  71. 

Do  diagnostics  81  )      Used  in  section  80. 

Free  up  local  linked  lists  83  )      Used  in  section  71. 

Get  appropriate  R-Queue  record  76)     Used  in  section  71. 

Get  next  record  63  )      Used  in  section  62. 

Get  output  file  name  46  )       Used  in  section  45. 

Initialize  the  lists  for  intensive  list-processing  54  )     Used  in  section  53. 

Instantiate  generics   16,  17,  18,  19,  20,  21,  22  )      Used  in  section  12. 

Move  record  from  input  list  to  ready  list  64 )     Used  in  section  62. 

Package  boiler-plate  12  )     Used  in  section  10. 

Procedures  and  Tasks  in  schedtooh   42,  43,  44,  45,  47,  49,  52,  53,  57,  58,  62,  66,  70,  71 ) 

Used  in  section  12. 
Reset  InDegree    87  )      Used  in  sections  84  and  86. 
Restore  FSched    89  )      Used  in  section  83. 
Restore  i?_ Queue    84)      Used  in  section  83. 
Restore  S-List    86  )      Used  in  section  83. 
Specification  of  procedures  visible  from  schedtooh   26,  27,  28,  29,  30,  31,  32,  34,  35,  36,  37,  38, 

39  )      Used  in  section  12. 
Specification  of  types  and  variables  visible  from  schedtooh   23,  24,  25,  33,  59 ) 

Used  in  section  12. 
Update  backtrack  counter  74  )     Used  in  section  71. 
Update  recursion  stuff  again  79  )     Used  in  section  71. 
Update  some  recursion  stuff  72 )     Used  in  section  71. 

Variables  local  to  Branch AndBound    73,  75,  77,  82,  85,  88,  90  )      Used  in  section  71. 
Variables  local  to  CreateNewStepList  51 )     Used  in  section  49. 

Variables  local  to  schedtooh    41,  55,  56  )       Used  in  section  12. 
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§         APPENDIX  B  INTRODUCTION 

1.      Introduction.      Here  is  the  Ada  code  for  utilites  used  in  Salah  Badr's  scheduler 
program.  His  program  was  written  by  him  May  25,  1993.  It  was  translated  by  John  Evans 
of  NRaD  into  Donald  Knuth's  WEB  format  for  literate  programming.  To  compile  and  link 
the  code  in  its  present  format  you  will  need  the  Ada  version  of  the  WEB  tool. 
It  is  available  on-line  via  the  world-wide-web  at  URL: 

http://white.nosc.mil/~evansjr/hterate/ 


2.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
see  the  paper  Literate  Programming,  by  Donald  Knuth  in  The  Computer  Journal,  Vol  27, 
No.  2,  1984;  or  the  book  Weaving  a  Program:  Literate  Programming  in  WEB  by  Wayne 
Sewell,  Van  Nostrand  Reinhold,  1989.  Another  good  source  of  information  is  the  Usenet 
group  comp. programming. literate.  It  has  information  on  new  tools  and  Frequently  Asked 
Questions  (FAQs). 

3.  Since  the  original  AWEB  package  was  written  for  Ada  '83,  it  does  not  properly  format 
new  Ada  '95  keywords  protected  and  private  .  We  remedy  using  the  web  format 
commands  below. 

format  protected  =  procedure 
format  private  =  procedure 

4.  As  a  way  of  explanation,  each  "Module"  withing  angle  brackets  (<  >)  is  expanded 
somewhere  further  down  in  the  document.  The  trailing  number  you  see  within  the  brackets 
is  where  you  can  find  this  expansion.  This  provides  a  type  of  PDL  (program  descriptor 
language)  for  your  program  and  greatly  aids  modularity  and  readability.  It  is  also  a  highly 
effective  method  of  top-down  programming.  The  first  module  here  is  expanded  further 
down,  and  contains  most  of  the  structure  in  standard  Ada  packages. 

(  Package  boiler-plate  5  ) 
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5.      Schedule  Primitives. 

(  Package  boiler-plate  5 )  = 

output  to  file  schedprims.ads 

with  generic  setjpkg] 
with  generic  ..map  jpkg; 
with  text  Jo ; 
use  textJo; 
with  test-io.pkg; 
use  test_io_pkg] 
with  Ada. Calendar] 
use  A  da.  calendar; 
with  capability; 
use  capability] 
with  ustrings] 
use  ustrings ; 
package  schedprims  is 

(Instantiate  generics  9) 

(  Specification  of  types  and  variables  visible  from  schedprims   6) 

(  Specification  of  procedures  visible  from  schedprims   11 ) 
end  schedprims ; 

output  to  file  schedprims  .adb 

with  test-io-pkg; 

with  calyr] 

use  calyr] 

package  body  schedprims  is 

( Variables  local  to  schedprims   25  ) 

( Procedures  and  Tasks  in  schedprims   26 ) 
end  schedprims ; 
This  code  is  used  in  section  4. 
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6.      I  make  this  a  tagged  record  so  that  I  can  extend  it  in  other  packages  that  inherit  this 


one. 


(  Specification  of  types  and  variables  visible  from  schedprims   6  )  = 

type  StepRecord    is    tagged  record  StepID  :  natural; 

Deadline  :  natural  <—  0; 

Priority  :  natural] 

EstimatedDuration  :  natural  <—  0; 

EarliestStartTime  :  natural  <—  0; 

ExpLevel  :  capjmap .map; 

Successors  :  natset.set; 

Predecessors  :  natset.set; 

InDegree  :  natural  «—  0; 

Recur sionLev el  :  natural  <—  0; 
end  record; 
See  also  sections  7  and  8. 
This  code  is  used  in  section  5. 

7. 

(  Specification  of  types  and  variables  visible  from  schedprims   6 )  +E 
type  ScheduleRecord  is 
record 

StepID  :  natural; 

Start  Time  :  natural; 

FinishTime  :  natural; 

Designer  :  ustring; 

StepLevel  :  capjmap  .map; 

Recur  sionLev  el  :  natural  <—  0; 
end  record; 

8. 

(  Specification  of  types  and  variables  visible  from  schedprims   6  )  +E 
type  CalendarRecord  is 
record 

StepID  :  natural; 
StartTime  :  Time; 
FinishTime  :  Time; 
Designer  :  ustring; 
StepLevel  :  capjmap  .map; 
end  record; 
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9.  Here  is  the  specification  for  generics. 

( Instantiate  generics  9 )  = 

package  natset  is  new  generic  setjpkg (natural ,5); 

{ Instantiate  instances  of  the  generic  map  package.  } 

package  natjmap  is  new  generic-map-pkg(key  =>  natural , result  =>  natural)', 

package  set-map  is  new  generic -map  jpkg  (key  =>  natural ,  result  =$>  natset. set ); 

package  expjmap  is  new  generic-map-pkg(key  =>■  natural ,  result  =>•  ExpertiseLevel)', 
See  also  section  10. 
This  code  is  used  in  section  5. 

10.  Here  is  the  specification  for  generics. 

( Instantiate  generics  9 )  += 

package  natjio  is  new  integer jio (natural); 

procedure  putset  is  new  natset .generic jput; 

procedure  getset  is  new  natset. generic-input; 

procedure  getfset  is  new  natset.  generic  -file  -input; 

package  enujio  is  new  textJo.EN\JMERAJ\ONJO(ExpertiseLevel); 

11.  This  function  is  used  to  compare  the  ID  of  StepRecords 

(  Specification  of  procedures  visible  from  schedprims   11 )  = 

function  CompareID(Ll  ,L2  :  Step  Record  )retum  Boolean; 
See  also  sections  12,  13,  14,  15,  16,  17,  18,  19,  20,  21,  22,  and  23. 
This  code  is  used  in  section  5. 

12.  This  function  is  used  to  compare  the  ID  of  StepRecords 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 
function  IsEqual(Ll  ,L2  :  Step  Record  )retum  Boolean; 

13.  This  function  is  used  to  compare  the  Deadline  of  StepRecords 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 

function  CompareDeadLine(Ll  ,L2  :  Step  Record  )retum  Boolean; 

14.  This  function  is  used  to  compare  the  Recursion  of  StepRecords 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 

function  CompareRecursionLevel(Ll  ,L2  :  Step  Record  )retum  Boolean; 

15.  This  function  is  used  to  compare  the  StartTime  of  StepRecords 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 

function  Compare  StartTime  (LI  ,L2  :  Schedule  Record  )return  Boolean; 
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16.  This  function  is  used  to  compare  the  StartTime  of  StepRecords 

(  Specification  of  procedures  visible  from  schedprims   11 )  +  = 

function  CompareStartTime(Ll  ,L2  :  Calendar  Record  )return  Boolean; 

17.  Printing  a  atep  heading  line  before  printing  any  records. 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 
procedure  StepRecordHeading ; 

18.  Display  a  record  given  its  LOCATION  in  the  list. 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 
procedure  Display  Step  Record  (rec  :  in  StepRecord); 

19.  Printing  a  schedule  heading  line  before  printing  any  record. 

(  Specification  of  procedures  visible  from  schedprims   11 )  -f= 
procedure  ScheduleRecordHeading ; 

20.  Printing  a  schedule  heading  line  before  printing  any  record. 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 
procedure  CalendarRecordHeading ; 

21.  display  a  record  given  its  LOCATION  in  the  list. 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 

procedure  Display ScheduleRecord [Current  :  in  ScheduleRecord); 

22. 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 

procedure  Save  ScheduleRecord  (Current  :  in  ScheduleRecord  \fd  :  file^type); 

23.      display  a  record  given  its  LOCATION  in  the  list. 

(  Specification  of  procedures  visible  from  schedprims   11 )  += 

procedure  Display CalendarRecord  (Current  :  in  Calendar  Record); 
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24.      Schedule  Primitives  Body. 

25. 

( Variables  local  to  schedprims   25 )  = 

debug  :  boolean  <—  false] 

debug2  :  boolean  <—  false; 
This  code  is  used  in  section  5. 

26. 

(  Procedures  and  Tasks  in  schedprims   26  )  = 

function  CompareID(Ll  ,L2  :  Step  Record  )return  Boolean  is 
begin 

if  Ll  .Stepld  <  L2.StepId  then 

return  True] 
else 

return  False; 
end  if; 
end  CompareW ; 
See  also  sections  27,  28,  29,  30,  31,  32,  33,  34,  35,  36,  37,  and  38. 
This  code  is  used  in  section  5. 

27.      Stepld's  are  suppose  to  be  unique. 

( Procedures  and  Tasks  in  schedprims  26  )  += 

function  IsEqual(Ll  ,L2  :  Step  Record  )retum  Boolean  is 
begin 

if  debug2  then 

pu<("Ll.StepIdu=uM);  naLio. put (Ll  .Stepld,  1);  jm*(M.uM); 
pu*(ML2.StepIdu=un);  naLio  .put  (L  2  .Stepld  ,1);  putJine{"  .u"); 
end  if; 
if  Ll  .Stepld  =  L2. Stepld  then 

return  True; 
else 

return  False; 
end  if; 
end  IsEqual; 
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28. 

(  Procedures  and  Tasks  in  schedprims   26  )  += 

function  CompareDeadline(Ll  ,L2  :  Step  Record  )retum  Boolean  is 
answer  :  boolean ; 
A, B  :  natural] 
begin 

A  <—  LI  .Deadline ;  B  <—  L2  .Deadline ; 
if  debug  then 

put("Ll  .Deadlineu=u");   naLio.put(A)]  puLline(n  .u"); 
pMt("L2.Deadlineu=uM);   nat_io .put(B)]  putJine ("  .u")> 
end  if; 
if  A  <  B  then 

answer  *—  True] 
else 

answer  <—  false] 
end  if; 
if  debug  then 

pu<("CompareDeadline>u"); 
if  answer  then 

nat-io.put(A)]  j>M<("uisuLESSuthenuM);  nat^io .put(B)]  puLline("  .u")] 
else 

naLio.put(A)]  puf("uisuNOTuLESSuthenu");  naLio .put(B)]  putJine{"  .  u")i 
end  if; 
end  if; 

return  answer] 
end  CompareDeadline ; 
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29. 

(  Procedures  and  Tasks  in  schedprims   26  )  += 

function  CompareRecursionLevel(Ll  ,L2  :  StepRecord  )return  Boolean  is 
answer  :  boolean ; 
A,B  :  natural] 
begin 

A  *—  LI . Recur sionLev el ;  B  <—  L2  .Recur  sionLev  el; 
if  A  <  B  then 

answer  <—  True; 
else 

answer  «—  false; 
end  if; 
if  debug  then 

pu2("CompareRecursionLevel>u"); 
if  anaiyer  then 

naL»o.pitt(i4);  jpu£("uisuLESSuthenu");  naLio.pu£(i?);  puLline("  .u" ); 
else 

not_to.pM<(>l);  put("uisuNOTuLESSuthenu");  naLio.pM<(.B);  pu£_Kne("  .u")i 
end  if; 
end  if; 

return  answer; 
end  CompareRecursionLevel ; 

30. 

(Procedures  and  Tasks  in  schedprims   26)  += 

function  CompareStartTime(Ll  ,L2  :  ScheduleRecord )return  Boolean  is 
begin 

if  Ll.StartTime  <  L2 .StartTime  then 

return  True; 
else 

return  False; 
end  if; 
end  CompareStartTime; 
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31. 

( Procedures  and  Tasks  in  schedprims    26  )  -f = 

function  CompareStartTime(Ll  ,L2  :  Calendar  Record  )return  Boolean  is 
begin 

if  LI  .StartTime  <  L2  .StartTime  then 

return  True; 
else 

return  False] 
end  if; 
end  CompareStartTime; 

32.  Printing  a  step  record  heading  line  before  printing  any  records. 

( Procedures  and  Tasks  in  schedprims   26  )  += 
procedure  StepRecordHeading  is 
begin 

texLio  .pM<(MSTEP_IDuuDEADLINEuuPRIORITYuuPREDECEuuuSUCCESSuuE_LEVELUuIN_DEGREE*i; 

texLio .7m*(MULIRECTJRSI0NM);   texLio .newJine] 

texLio  .puty  UUU-"  "— UUU-'  "-UU  UUUU--  "-UU-"  "— UU" '  v: 

texLio  .put ("uu ")i   texLio  .new Jine ', 

end  StepRecordHeading ; 

33.  Display  a  record  given  its  LOCATION  in  the  list. 

(  Procedures  and  Tasks  in  schedprims   26  )  += 

procedure  Display  Step  Record  (rec  :  in  StepRecord)  is 
begin 

texLio .seLcol(4);   tesLio-pkg .put(rec .Stepld)]   texLio .seLcol (12); 

tesLio-pkg .put (rec .Deadline);   texLio .seLcol(23)\   tesLio_pkg .put (rec .Priority); 

texLio  .seLcol(31);  puLset (rec  .Predecessors  );   texLio  .seLcol (41); 

puLset(rec  .Successors  );  texLio  .seLcol  (49);  prinLcapabilities  (rec.  Exp  Lev  el); 

texLio .seLcol(Ql);   tesLio..pkg .put (rec .InDegree);   texLio .seL col (72); 

tesLio-pkg  .put(rec . Recur sionLev el);   texLio  .new Aine ; 
end  Display  Step  Record ; 

34.  Printing  a  schedule  heading  line  before  printing  any  record. 

( Procedures  and  Tasks  in  schedprims   26  )  += 
procedure  ScheduleRecordHeading  is 
begin 

iezLx'o.p^C'IDuSTART.TIMEuFINISH.TIMEuuS.LEVELuuuuuuuuuuuDEVEOPER"); 
texLio  .newAine ; 

texLio  ,put("      u  u  uu~"  uuuuuuuuuuu-"  "  )j 

texLio  .new-line ; 
end  ScheduleRecordHeading ; 
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35.  Printing  a  schedule  heading  line  before  printing  any  record. 

(  Procedures  and  Tasks  in  schedprims  26  )  += 
procedure  CalendarRecordHeading  is 
begin 

texUo  .pu«(,,IDuSTART_TIMEuFINISH_TIMEuuS_LEVELuuuuuuuuuuuDEVEOPER"); 
texLio  .new-line ; 

teXl-lO  .ptlty  (J  LI  UU  UUUUUUUUUUU  )\ 

texLio  .new-line ; 
end  CalendarRecordHeading ; 

36.  Display  a  record  given  its  LOCATION  in  the  list. 

(  Procedures  and  Tasks  in  schedprims  26  )  += 

procedure  Display ScheduleRecord  ( Current  :  in  ScheduleRecord  )  is 
begin 

texLio .seLcol(l);   naLio .put(Current .StepID ,  1);   texLio .set- col [10); 

naLio .put (Current .StartTime ,  1);   texLio .seLcol (20); 

naLio .put(Current .FinishTime ,  1);  texLio .seLcol(35); 

print-capabilities  ( Current.  StepLevel);   texLio  .put  ("u"); 

texLio  .put(S(  Current  .Designer));   texLio  .newAine ; 
end  Display  ScheduleRecord ; 

37.  Display  a  record  given  its  LOCATION  in  the  list. 

(  Procedures  and  Tasks  in  schedprims   26  )  += 

procedure  Save  ScheduleRecord  (Current  :  in  ScheduleRecord  ;fd  :  file-type)  is 

package  NaLlo  is  new  Integer.Io  (Natural); 

use  NaLio; 
begin 

texLio .seLcol(fd ,  1);  put(fd,  Current. StepID ,1);   texLio .seLcol(fd ,10); 

put(fd,  Current  .StartTime  ,1);   texLio  .seLcol(fd  ,20); 

put(fd,  Current  .FinishTime  ,1);  £ezLio..seLco/(/</,35); 

prinLcapabilities  (fd ,  Current. StepLevel);  put(fd,"u");  put(fd,  Current  .Designer); 

texLio  .new-line (fd); 
end  S aveS cheduleRecord ; 
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38.      Display  a  record  given  its  LOCATION  in  the  list. 

{  Procedures  and  Tasks  in  schedprims   26  )  += 

procedure  Display  CalendarRecord  (Current  :  in  Calendar  Record)  is 
begin 

texLio .seLcol(2)\   tesLio-pkg  .put(Current  .StepID);   texLio .seLcol (10); 

calyr .print-date ( Current  .StartTime);   texLio .seLcol(25); 

calyr .print-date ( Current .FinishTime );   texLio . seLcol(AO)] 

print-capabilities  (Current  .StepLevel)]   texLio  .put  ("uuM)i 

texLio  .put(S(  Current  .Designer))',  texLio  .newAine ; 
end  Display  CalendarRecord] 
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39.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

40.  RCS  Keywords. 

$RCSfile:  schedprims.aweb,v 

$  Revision:  1.4 

$Date:  1997/08/22  23:14:45 

$Author:  evansjr 

$Id:  schedprims.aweb,v  1.4  1997/08/22  23:14:45  evansjr  Exp  evansjr 

$Locker:  evansjr 
$State:  Exp 
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INDEX 


41.  Index.  Here  is  a  cross-reference  table  for  the  MAIN  program.  All  modules  in  which 
an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are  indexed 
only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers  in  module 
names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  correspond  to 
sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond  to  the 
section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


Ada:     5. 

FinishTime:     7—8,  36—38 

answer:     28-29. 

generic_file_input:     10. 

boolean:     25,  28-29. 

genericAnput:     10. 

Boolean:     11-16,  26-31. 

generic-map^pkg:     5,  9. 

Calendar:     5. 

generic-put:     10. 

calendar :     5. 

genericseLpkg:     5,  9. 

Calendar  Record:     8,  16, 

23, ; 

31,  38. 

get-set:     10. 

CalendarRecordHeading : 

20 

,35- 

getfset:     10. 

calyr:     5,  38. 

ID:     11-12. 

cap_map:     6—8. 

InDegree:     6,  33. 

capability :     5. 

integer_io :     10. 

CompareDeadline :     28. 

Integer Ao:     37. 

CompareDeadLine :     13. 

IsEqual:     12,  27. 

ComparelD:     H,  26. 

key:     9. 

CompareRecursionLevel : 

14 

,  29. 

LI:     11-16,  26-31. 

CompareStartTime:     15, 

16, 

30,  31. 

L2:     11-16,  26-31. 

Current:     21-23,  36-38. 

map:     6—8. 

Deadline:     6,  13,  28,  33 

naUo:     10,  27-29,  36. 

debug:     25,  28-29. 

NaUo :     37. 

debug2:     25,  27. 

naLmap :     9. 

Designer:     7-8,  36-38. 

naLset:     6,  9,  10. 

Display  Calendar  Record : 

23, 

38- 

natural:     6-10,  28-29. 

Display  ScheduleRecord : 

21, 

36- 

Natural:     37. 

Display  Step  Record  :     18, 

33- 

newAine:     32-38. 

EarliestStartTime:     6. 

Predecessors :     6,  33. 

enu-io :     10. 

print-capabilities  :     33,  3( 

ENUMERATIONJO:     10. 

print-date:     38. 

EstimatedDuration:     6. 

Priority:     6,  33. 

exp_map:     9. 

private:     3. 

ExpertiseLevel:     9-10. 

procedure:     3. 

ExpLevel:     6,  33. 

protected:     3. 

False:     26-27,  30-31. 

put:     27-29,  32-38. 

false:     25,  28-29. 

putJine:     27-29. 

fd:     22,  37. 

puLset:     10,  33. 

file_type:     22,  37. 

rec:     18,  33. 
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Recursion:     14. 

RecursionLevel :     6-7,  29,  33. 

result:     9. 

SaveScheduleRecord :     22,  37. 

schedprims:     5. 

schedprims . adb  :  5. 

schedprims. ads  :  5. 

ScheduleRecord:     7,  15,  21-22,  30,  36-37. 

ScheduleRecordHeading :     19,  34. 

set:     6,  9. 

seLcol:     33,  36-38. 

set-map:     9. 

StartTime:     7-8,  15-16,  30-31,  36-38. 

StepID:     6-8,  36-38. 

Stepld:     26-27,  33. 

StepLevel:     7-8,  36-38. 

StepRecord:     6,  11-14,  18,  26-29,  33. 

Step RecordHea ding  :     17,  32. 

StepRecords :     11-16. 

Successors :     6,  33. 

system  dependencies:     39. 

tagged:     6. 

test-io-pkg:     5,  33,  38. 

texUo:     5,  10,  32-38. 

Time :     8. 

True:     26-31. 

ustring:     7-8. 

ustrings:     5. 
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( Instantiate  generics  9,  10  )      Used  in  section  5. 

(  Package  boiler-plate   5  )       Used  in  section  4. 

(Procedures  and  Tasks  in  schedprims   26,  27,  28,  29,  30,  31,  32,  33,  34,  35,  36,  37,  38) 

Used  in  section  5. 
(Specification  of  procedures  visible  from  schedprims   11,  12,  13,  14,  15,  16,  17,  18,  19,  20,  21, 

22,  23  )       Used  in  section  5. 
(  Specification  of  types  and  variables  visible  from  schedprims   6,  7,  8  )     Used  in  section  5. 
( Variables  local  to  schedprims   25  )      Used  in  section  5. 
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§  APPENDIX  C  INTRODUCTION 

1.  Introduction.  Here  is  the  Ada  code  for  Salah  Badr's  scheduler  program.  It  was 
written  by  him  May  25,  1993.  Here  it  has  been  translated  to  Donald  Knuth's  WEB  format 
for  literate  programming.  To  compile  and  link  the  code  in  its  present  format  you  will  need 
the  Ada  version  of  the  WEB  tool. 

It  is  available  on-line  via  the  world- wide- web  at  URL: 

http://white.nosc.mil/~evansjr/Hterate/ 


2.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
see  the  paper  Literate  Programming,  by  Donald  Knuth  in  The  Computer  Journal,  Vol  27, 
No.  2,  1984;  or  the  book  Weaving  a  Program:  Literate  Programming  in  WEB  by  Wayne 
Sewell,  Van  Nostrand  Reinhold,  1989.  Another  good  source  of  information  is  the  Usenet 
group  comp. programming. literate.  It  has  information  on  new  tools  and  Frequently  Asked 
Questions  (FAQs). 

3.  The  program  consists  of  several  packages  that  are  declared  right  now;  each  of  these 
packages  and  either  the  specification  and  the  body  of  the  packages  are  sent  to  a  separate 
file.  The  main  program  itself  is  declared  later.  (Since  the  original  AWEB  package  was 
written  for  Ada  '83,  it  does  not  properly  format  new  Ada  '95  keywords  protected  and 
private  .  We  remedy  using  the  web  format  commands  below. 

format  protected  =  procedure 
format  private  =  procedure 

4.  As  a  way  of  explanation,  each  "Module"  within  angle  brackets  (<  >)  is  expanded 
somewhere  further  down  in  the  document.  The  trailing  number  you  see  within  the  brackets 
is  where  you  can  find  this  expansion.  This  provides  a  type  of  PDL  (program  descriptor 
language)  for  your  program  and  greatly  aids  modularity  and  readability.  It  is  also  a  highly 
effective  method  of  top-down  programming. 
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5.      Main  driver.      This  is  the  main  routine  that  starts  everything. 
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6.  (Note:  The  following  format  is  used  by  all  the  packages.  We  write  the  top-level  code, 
in  macro-level  descriptions,  and  it  gets  expanded  into  code  further  down.  This  way  you 
can  write  small,  easily  understood  modules.  It  also  lets  you  declare  and  describe  variables 
and  types  where  you  need  them.) 

output  to  file  main.adb 

pragma  suppress (alLchecks); 
with  SchedTools ; 
with  scheduler; 
use  scheduler; 
with  text  Jo; 
use  text-io; 
with  capability; 
use  capability; 
with  ustrings; 
use  ustrings ; 

procedure  main  is  (Instantiate  generic  packages  8 )( Variables  local  to  main  9) 
begin 
loop 
begin 

SCHEDULER-MENU;  get(SELECTOR);  shipJine; 
case  SELECTOR  is 
when  1  => 

( Create  new  step  list  10 ) 
when  2  => 

( Read  in  developer  list  12  ) 
when  3  => 

(  Schedule  steps  according  to  their  deadlines  14 ) 
when  4  =$> 

( Print  all  steps  in  the  ready  queue  15 ) 
when  5  => 

(  Print  all  step  records  19  ) 
when  6  =$> 

( Print  final  schedule  16  ) 
when  7  => 

(  Save  final  schedule  17  ) 
when  8  => 

(  Print  calendar  schedule  18  ) 
when  9  => 

( Exit  the  program  to  the  system  20  ) 
when  others   => 

( Exception  handling  for  selector  case  21 ) 
end  case; 
exception 
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when  storage-error  =$■ 

putJine  ("Youuhaveuaustorageuerror .  "  ); 

pM<("Youruleveluofurecursionuisu");  natJo  .put(recursionJevel); 
putJine  ("  .u"); 
when  DataJError  => 

pwUmeC'Valueuentereduiiotuiiiuproperuraiige . uuPleaseutryuagaiii .  M ); 
NewJine ;   SkipJLine ; 

when  SchedTools.NoFeasibleScheduleFound  => 

Pw*-Knc("Unableutoufindufeasibleuschedule.ULJNeedutouincreaseulaxity.f 
NewJine ; 

when  NoDevelopers  =>• 

putJine ("Noudevelopersutouscheduleutasksuwith.uuPleaseutryuagain. f; 
NewJine] 

end; 

end  loop; 

end  main; 

7.  As  a  way  of  explanation,  each  "Module"  withing  angle  brackets  (<  >)  is  expanded 
somewhere  further  down  in  the  document.  The  trailing  number  you  see  within  the  brackets 
is  where  you  can  find  this  expansion.  This  provides  a  type  of  PDL  (program  descriptor 
language)  for  your  program  and  greatly  aids  modularity  and  readability.  It  is  also  a  highly 
effective  method  of  top-down  programming.  The  first  module  here  is  expanded  further 
down,  and  contains  most  of  the  structure  in  standard  Ada  packages. 
(  Package  boiler-plate  22  ) 

8. 

( Instantiate  generic  packages  8 )  = 

package  natJo  is  new  integer  Jo  (natural); 

use  natJo; 
This  code  is  used  in  section  6. 

9. 

( Variables  local  to  main  9 )  = 

type  selector  Jype  is  new  natural  range  1  . .  9- 
selector  :  selector  Jype  <—  1; 

package  selJo  is  new  integer  Jo  (selector  Jype); 
use  selJo; 

See  also  sections  11  and  13. 

This  code  is  used  in  section  6. 
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10.      This  routine  has  been  modified  to  read  in  a  file  and  build  up  the  linked  list  of  "steps." 

(  Create  new  step  list  10  )  = 
if  numAevelopers  >  0  then 

MakeNewStepList(num_developers ); 
else 

raise  NoDevelopers ; 
end  if; 

This  code  is  used  in  section  6. 

11. 

(Variables  local  to  main  9)  += 
NoDevelopers  :  exception; 

12. 

( Read  in  developer  list  12  )  = 

pw<_/me("Pleaseuenterudeveloperuf  ileuname:u"); 

getJine{infile); 

get. developers (S(infile));  num-developers  *—  getjfiumAevelopers\ 
This  code  is  used  in  section  6. 

13. 

( Variables  local  to  main  9 )  += 
infile  :  ustring; 
num-developers  :  natural  <—  0; 

14. 

( Schedule  steps  according  to  their  deadlines  14 )  = 

PutJine ("Schedulingustepsuaccordingutoutheirudeadlines. "); 
MakeDeadlineFirstSchedule  (maxjrecursion ,  num-developers ); 

This  code  is  used  in  section  6. 

15. 

( Print  all  steps  in  the  ready  queue  15 )  = 

PrintReady  Queue ; 
This  code  is  used  in  section  6. 

16. 

( Print  final  schedule  16 }  = 

PrintFinalSchedule ; 
This  code  is  used  in  section  6. 
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17. 

(  Save  final  schedule  17 )  = 

SaveFinalSchedule ; 
This  code  is  used  in  section  6. 

18. 

(  Print  calendar  schedule  18  )  = 

PrintCalendar  Schedule ; 
This  code  is  used  in  section  6. 

19. 

( Print  all  step  records  19 )  = 

newJine ;  PrintStepList ; 
This  code  is  used  in  section  6. 

20. 

( Exit  the  program  to  the  system  20 )  = 

pu<("MaximumurecursionulevGluisu"  );  not  Jo .put(max-recursion)]  putJine("  .u")5 
put  ( "Current  urecursionuleveluisu" );  nat  Jo  .put  (recursion-level);  putJine("  ,u"); 
jpwf("thankuyouu.  .  .  .uByeu.  .  .Bye");  newJine;  exit; 

This  code  is  used  in  section  6. 

21. 

( Exception  handling  for  selector  case  21 )  = 

put ( "uBADuCH0ICE . UPLEASEUTRYUAGAIN" );  newJine ; 
This  code  is  used  in  section  6. 
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22.  Scheduler  specification. 

(  Package  boiler-plate  22  )  = 
output  to  file  scheduler. ads 

•with  genericsetjpkg] 
"with  generic  jmapjpkg ; 
with  generic  Jist] 
with  schedprims ; 
use  schedprims ; 
with  schedtools ; 
use  schedtools ; 
with  TEXTJO; 
use  TEXTJO; 
with  tesLio^pkg ; 
use  tesLio-pkg] 
package  scheduler  is 

( Specification  of  types  and  variables  visible  from  scheduler  23 ) 

(  Specification  of  procedures  visible  from  scheduler  24 ) 
end  scheduler] 

output  to  file  scheduler. adb 

with  unchecked- deallocation; 
package  body  scheduler  is 

(  Procedures  and  Tasks  in  scheduler  33  ) 
end  scheduler] 
This  code  is  used  in  section  7. 

23.  Here  are  variables  global  to  the  recursion. 

(  Specification  of  types  and  variables  visible  from  scheduler  23  )  = 

recursion-level  :  natural  <—  0; 

max.recursion  :  natural  <—  0; 
This  code  is  used  in  section  22. 

24.  Creating  new  step. 

(  Specification  of  procedures  visible  from  scheduler  24 )  = 
Procedure  MakeNewStepList(num^dev elopers  :  natural)] 
See  also  sections  25,  26,  27,  28,  29,  30,  and  31. 
This  code  is  used  in  section  22. 

25.  Creating  new  step. 

(  Specification  of  procedures  visible  from  scheduler  24  )  += 

Procedure  MakeDeadlineFirstSchedule (max-recursion  :  in  out  natural] 
num^dev elopers  :  natural)] 
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26. 

(  Specification  of  procedures  visible  from  scheduler  24  )  += 
procedure  SCHEDULER-MENU; 

27. 

(  Specification  of  procedures  visible  from  scheduler  24  )  += 
procedure  PrintReady Queue; 

28. 

(  Specification  of  procedures  visible  from  scheduler  24  )  += 
procedure  PrintFinalSchedule; 

29. 

(  Specification  of  procedures  visible  from  scheduler  24 )  += 
procedure  SaveFinalSchedule; 

30. 

(  Specification  of  procedures  visible  from  scheduler  24 )  += 
procedure  Print  Calendar  Schedule; 

31. 

(  Specification  of  procedures  visible  from  scheduler  24  )  += 
procedure  PrintStepList; 
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32.  Scheduler  Body. 

33.  Creating  new  step. 

(  Procedures  and  Tasks  in  scheduler  33  )  = 

Procedure  MakeNew Step List (num-dev elopers  :  natural)    is 
begin 

CreateNewStepList  (StepList); 
end  MakeNew Step List ; 

See  also  sections  34,  35,  36,  37,  38,  39,  and  40. 
This  code  is  used  in  section  22. 

34. 

(Procedures  and  Tasks  in  scheduler  33)  += 

Procedure  MakeDeadLineFirstSchedule{max_recursion  :  in  out  natural] 

num^dev elopers  :  natural)    is 
begin 

/mi_/me("StartuofuCreateDeadlineFirstSchedule. "); 
CreateDeadlineFirstSchedule(max..recursion ,  num^dev elopers  ); 
pML/ine("EriduofuCreateDeadlineFirstSchedule. "); 
end  MakeDeadLineFirstSchedule ; 
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35.     DISPLAY  THE  MAIN  MENU. 

( Procedures  and  Tasks  in  scheduler  33 )  += 
procedure  SCHEDULER-MENU  is 
begin 

newJine]  seLcol(25)]  pu<("MAINuMENU");  newJine;  seLcol(25); 

put(" ");  newJine(2)\ 

seLcol(5)]  put 

newJine] 

seLcol(5)]  put 
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newJine] 
seLcol(5)]  put 
newJine] 
seLcol(5)]  put 
newJine] 
set^col(5)]  put 
newJine] 
aeLco/(5);  put 
newJine] 
seLcol(5)]  put 
newJine ; 
seLcol(5)]  put 
newJine ; 
seLcol(5)]  put 


"  [l]uR®aduiiiustepulist"); 

"  [2]  uReaduinudeveloperulist" ); 

" [3] uscheduleustepsuusinguBranchAndBound" ); 

"  [4]  uPrintureadyuqueue" ); 

"  [5]uPrintustepulistM); 

" [6]uPrintufinaluscheduleM); 

"  [7]  uSaveuf  inaluschedule" ); 

"  [8]  uPrintuCalendaruschedule" ); 


'"  [9]uQuit");  newJine(3)]  seLcol(5); 
pu<("Enterutheunumberuofuyouruchoiceu:uu"); 
end  SCHEDULER_MENU; 

36. 

( Procedures  and  Tasks  in  scheduler  33 )  += 
procedure  PrintFinalSchedule  is 
begin 

Print AUS cheduleRecords  (Schedule ); 
end  PrintFinalSchedule ; 

37. 

( Procedures  and  Tasks  in  scheduler  33 )  += 
procedure  SaveFinalSchedule  is 
begin 

Save  AUS  cheduleRecords  (Schedule ); 
end  SaveFinalSchedule ; 
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38. 

( Procedures  and  Tasks  in  scheduler  33 )  += 
procedure  PrintCalendarSchedule  is 
begin 

Print  AUCalendarRecords  (Schedule ); 
end  PrintCalendarSchedule; 

39. 

( Procedures  and  Tasks  in  scheduler  33 )  += 
procedure  PrintReady Queue  is 
begin 

Print  AllStep Records  (ReadyQueue ); 
end  PrintReady  Queue ; 

40. 

( Procedures  and  Tasks  in  scheduler  33 )  += 
procedure  PrintStepList  is 
begin 

Print  AllStep  Records  (StepList ); 
end  PrintStepList] 
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41.  Continuous  Time  to  Calendar  Time  Translator.  The  purpose  of  this  routine 
is  to  take  the  output  of  the  scheduler  and  translate  the  continuous  time  fields  (StartTime 
and  FinishTime)  to  calendar  dates. 

output  to  file  contocal.adb 

pragma  suppress (alLchecks); 

with  text Jo ; 

use  texLio; 

with  getopt] 

use  getopt] 

with  Ustrings] 

use  U strings ; 

with  Ada. Calendar; 

use  Ada. Calendar] 

with  calyr] 

use  calyr] 

with  capability] 

use  capability] 

procedure  ConToCal  is 

( Variables  local  to  ConToCal  45 ) 

package  booLio  is  new  enumeration  Jo  [boolean)] 

use  booLio; 
begin 

(Get  parameters  to  ConToCal  43) 

(  Open  files  51 ) 

(Iterate  through  input  file  53)  end  ConToCal] 

42.  The  command  syntax  is  as  follows: 

contocal  [-nrad  <  boolean  >]  [-start  <  startdate  >]  infile  outfile 


43.      The  -nrad  option  is  by  default  false,  but  when  set  to  true  will  create  a  schedule  that 
respects  NRaD  off-fridays.  An  example  invocation  coule  be: 


contocal  -nrad  true  -start  07/03/97+00  infile  outfile 

If  no  start  is  given  then  the  default  is  the  same  as  the  example. 

(Get  parameters  to  ConToCal  43)  = 

(  Get  nrad  44 ) 

(  Get  start  date  46  ) 

(  Get  input  file  48  ) 

(  Get  output  file  50  ) 
This  code  is  used  in  section  41. 
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44. 

(  Get  nrad  44 )  = 

if  option^present (Z7("-nradM))  then 

get-option(U('l-iira.dn),  param);  get(S(param),  nrad  ,  Last); 
else 

nrad  <—  false; 
end  if; 

This  code  is  used  in  section  43. 

45. 

( Variables  local  to  ConToCal  45 )  = 

param  :  U string; 

Last  :  positive ; 

nrad  :  boolean; 
See  also  sections  47,  49,  52,  55,  56,  and  58. 
This  code  is  used  in  section  41. 

46. 

(  Get  start  date  46  )  = 

if  option-present (U(n- start"))  then 

<7eLoph'on(£/(M-start"), param);  StartDate  <—  geLdate  (param); 
else 

StartDate  <-  Time.Of  (1997, 7, 3, 0.0); 
end  if; 

This  code  is  used  in  section  43. 

47. 

( Variables  local  to  ConToCal  45 )  += 
StartDate  :  Time; 

48. 

(  Get  input  file  48 )  = 

if  name-present  (1)  then 

geLname  (infile ,  1); 
else 

raise  nofilename; 
end  if; 

This  code  is  used  in  section  43. 
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49. 

( Variables  local  to  ConToCal  45 )  += 
nofilename  :  exception; 
in  file ,  outfile  :  U string] 

50. 

(  Get  output  file  50  }  = 
if  name-present{2)  then 

geLname  (outfile ,  2); 
else 

raise  nofilename; 
end  if; 
This  code  is  used  in  section  43. 

51. 

(  Open  files  51 )  = 

open  (data- file ,  in-file ,  S(infile ));   create  (data2- file ,  ouLfile ,  S(outfile )); 
This  code  is  used  in  section  41. 

52. 

( Variables  local  to  ConToCal  45 )  += 
data-file ,  data2-file  :  file-type ; 

53. 

( Iterate  through  input  file  53 )  = 
while  ->End-Of-File(data-file)  loop 

( Read  in  record  54  ) 

( Do  time  translations  57 ) 

( Write  out  new  record  59 ) 
end  loop; 

This  code  is  used  in  section  41. 
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54.      A  typical  input  file  would  look  like  the  following: 


3 

HIGH 

HI 

0 

3 

2 

MEDIUM 

Ml 

0 

4 

1 

LOW 

LI 

0 

6 

4 

HIGH 

HI 

3 

13 

5 

MEDIUM 

Ml 

4 

12 

6 

LOW 

LI 

6 

10 

8 

MEDIUM 

Ml 

12 

14 

7 

LOW 

LI 

10 

15 

9 

HIGH 

HI 

13 

19 

10 

MEDIUM 

Ml 

14 

24 

The  second  to  last  column  is  the  start  time  and  the  last  column  is  the  end  time. 

(  Read  in  record  54 )  = 

kntr  <—  kntr  +  1;  j?u<(MReadinguinurecorduM);  put(kntr);  puLline("  .u")i 
get  (data- file,  stepid)]  get(data-file,  Start)]  g  et  (data-  file ,  Finish)] 
get- cap  ability  (data-file ,  ExpLevel);  get-line  (data- file ,  Developer); 

This  code  is  used  in  section  53. 

55. 

( Variables  local  to  ConToCal  45 )  += 

type  ExpertiseLevel  is  (low ,  medium ,  high); 

stepid  :  natural] 

ExpLevel  :  cap-map  .map ; 

Developer  :  ustring; 

start, finish  :  natural] 

kntr  :  natural  <—  0; 

56. 

( Variables  local  to  ConToCal  45 )  += 

package  exp-io  is  new  enumeration-io (ExpertiseLevel)] 

use  exp-io] 

package  nat-io  is  new  integer-io (natural); 

use  nat-io  ] 

57. 

(  Do  time  translations  57  )  = 

dur  <—  ConvertH  ours  To  Duration  (Start)] 

StartTime  <—  DurationToCalendarTime(StartDate,  dailyhours  ,  dur,  NRaD); 

dur  <—  ConvertH  our  sTo  Duration  (Finish); 

FinishTime  *—  DurationTo  Calendar  Time  (StartDate ,  dailyhours  ,  dur,  NRaD ); 
This  code  is  used  in  section  53. 
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58. 

( Variables  local  to  ConToCal  45 )  += 
dur  :  Duration] 

Start  Tim e ,  Finis h  Tim e  :  Tim e ; 
dailyhours  :  WorkHours  <—  (ConvertHoursToDuration(8),  ConvertH  ours  To  Duration  (8), 

ConvertHoursToDuration(8),  ConvertHoursToDuration{8), 

ConvertHours  ToDuration  (8)); 

59. 

( Write  out  new  record  59 )  = 

set_col(data2-file ,  1);  put  (data2- file,  stepid,  1);  seLcol  (data2-file ,  10); 

print-date  (data2- file ,  StartTime);  set-Col(data2-file ,25); 

print-date (data2-file ,  FinishTime );   set-col  (data2-file , 40); 

print-capabilities  (data2-file ,  ExpLevel);  put  (data2- file,  "u")? 

put ( data2-file , Developer)]  new-line(data2-file ); 
This  code  is  used  in  section  53. 
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60.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

61.  RCS  Keywords. 

$RCSfile:  main.aweb,v 

$  Revision:  1.5 

$Date:  1997/08/22  23:14:45 

$Author:  evansjr 

$Id:  main.aweb,v  1.5  1997/08/22  23:14:45  evansjr  Exp  evansjr 

$Locker:  evansjr 
$  State:  Exp 
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62.  Index.  Here  is  a  cross-reference  table  for  the  MAIN  program.  All  modules  in  which 
an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are  indexed 
only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers  in  module 
names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  correspond  to 
sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond  to  the 
section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


Ada:     41. 

alLchecks:     6,  41. 

booLio:     41. 

boolean:     41,  45. 

Calendar:     41. 

calyr:     41. 

cap-map:     55. 

capability:     6,  41. 

ConToCal:     41. 

contocal.adb  :  41. 

ConvertHoursToDuration:     57-58. 

create:     51. 

CreateDeadlineFirstSchedule :     34. 

CreateNewStepList:     33. 

dailyhours :     57-58. 

Data^Error :     6. 

data-file:     51-54. 

datat-file:     51-52,  59. 

Developer:     54-55,  59. 

dur:     57-58. 

Duration :     58. 

DurationTo  Calendar Time:     57. 

End-Of.File:     53. 

enumeration-io :     41,  56. 

exp_io:     56. 

ExpertiseLevel:     55,  56. 

ExpLevel:     54-55,  59. 

false:     44. 

fileAype:     52. 

Finish:     54,  57. 

finish:     55. 

FinishTime:     41,  57-59. 

generic  -list:     22. 

generic-map-pkg :     22. 

genericset-pkg:     22. 


get:     6,  44,  54. 

geLcapability :     54. 

get-date:     46. 

get-developers :     12. 

get-line:     12,  54. 

get-name:     48,  50. 

get-num-dev elopers :     12. 

get-option:     44,  46. 

getopt:     41. 

high:     55. 

in- file:     51. 

infile:     12-13,  48-49,  51. 

integer-io:     8-9,  56. 

kntr:     54-55. 

Last:     44-45. 

low:     55. 

main :     6. 

main . adb :     6. 

MakeDeadlineFirst Schedule:     14,  25. 

MakeDeadLineFirstSchedule :     34. 

MakeNewStepList:     10,  24,  33. 

map:     55. 

max-recursion :     14,  20,  23,  25,  34. 

medium:     55. 

name-present:     48,  50. 

naLio :     6,  8,  20,  56. 

natural:     8-9,  13,  23-25,  33-34,  55-56. 

new-line:     19—21,  35,  59. 

NewJine:     6. 

NoDevelopers:     6,  10-11. 

NoFeasibleScheduleFound:     6. 

nofilename:     48-50. 

nrad:     44-45. 

NRaD :     57. 

num-developers  :     10,  12-14,  24-25,  33-34. 
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open:     51. 

option-present:     44,  46. 

out-file:     51. 

outfile:     49-51. 

param:     44-46. 

positive :     45. 

prints  capabilities:     59. 

print-date:     59. 

Print AUCalendar Records  :     38. 

Print AUS cheduleRecords  :     36. 

PrintAUStepRecords :     39-40. 

PrintCalendar Schedule:     18,  30,  38. 

PrintFinalSchedule:     16,  28,  36. 

PrintReady  Queue  :     15,  27,  39. 

PrintStepList:     19,  31,  40. 

private:     3. 

Procedure:     24-25,  33-34. 

procedure:     3. 

protected:     3. 

put:     6,  20-21,  35,  54,  59. 

PutJine :     14. 

putJine:     6,  12,  20,  34,  54. 

ReadyQueue:     39. 

recursion^  lev  el:     6,  20,  23. 

Save  AUS  cheduleRecords  :     37. 

SaveFinalSchedule:     17,  29,  37. 

schedprims :     22. 

SchedTools :     6. 

schedtools :     22. 

Schedule :     36-38. 

scheduler:     6,  ££. 

scheduler. adb  :     22. 

scheduler. ads  :     22. 

SCHEDULER-MENU:     6,  26,  35- 

aeLto:     9. 

selector:     9. 

SELECTOR:     6. 

selector-type:     9. 

set-col:     35,  59. 

skip-line:     6. 

Skip- Line :     6. 

S<ar<:     54,  57. 

start:     55. 


StartDate:     46-47,  57. 
StartTime:     41,  57-59. 
stepid:     54—55,  59. 
StepList:     33,  40. 
storage- error:     6. 
suppress :     6,  41. 
system  dependencies: 
test-io-pkg:     22. 
TEXTJO:     22. 
ieasLio:     6,  41. 
Time:     47,  58. 
Time-Of:     46. 
trwe:     43. 

unchecked- deallocation : 
ustring:     13,  55. 
Ustring:     45,  49. 
U strings:     41. 
ustring  s :     6. 
WorkHours :     58. 


60. 


22. 
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(  Create  new  step  list    10  )       Used  in  section  6. 

(  Do  time  translations  57  )      Used  in  section  53. 

(  Exception  handling  for  selector  case  21 )     Used  in  section  6. 

(  Exit  the  program  to  the  system  20  )     Used  in  section  6. 

(  Get  input  file  48  )       Used  in  section  43. 

(  Get  nrad  44  )       Used  in  section  43. 

(  Get  output  file  50  )      Used  in  section  43. 

(  Get  parameters  to  ConToCal  43 )      Used  in  section  41. 

(  Get  start  date  46  )      Used  in  section  43. 

( Instantiate  generic  packages  8  )     Used  in  section  6. 

( Iterate  through  input  file  53 )     Used  in  section  41. 

(  Open  files  51  )      Used  in  section  41. 

(  Package  boiler-plate   22  )       Used  in  section  7. 

(  Print  all  step  records  19  )      Used  in  section  6. 

( Print  all  steps  in  the  ready  queue  15 )      Used  in  section  6. 

(  Print  calendar  schedule  18  )      Used  in  section  6. 

(  Print  final  schedule  16  )       Used  in  section  6. 

(  Procedures  and  Tasks  in  scheduler  33,  34,  35,  36,  37,  38,  39,  40  )     Used  in  section  22. 

(  Read  in  developer  list  12  )     Used  in  section  6. 

(  Read  in  record  54  )      Used  in  section  53. 

(  Save  final  schedule  17  )      Used  in  section  6. 

(  Schedule  steps  according  to  their  deadlines  14  )     Used  in  section  6. 

( Specification  of  procedures  visible  from  scheduler  24,  25,  26,  27,  28,  29,  30,  31 ) 

Used  in  section  22. 
(  Specification  of  types  and  variables  visible  from  scheduler   23  )      Used  in  section  22. 
(Variables  local  to  ConToCal  45,  47,  49,  52,  55,  56,  58  )      Used  in  section  41. 
(  Variables  local  to  main  9,  11,  13  )      Used  in  section  6. 
( Write  out  new  record  59  )      Used  in  section  53. 
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§  Appendix  D  INTRODUCTION 

1.  Introduction.  The  scheduler  designed  and  implemented  by  Salah  Badr  uses  lists 
extensively.  However,  it  has  specific  routines  for  each  list  used  by  the  scheduler.  This  is 
redundant,  as  well  as  error  prone.  In  my  design  to  eliminate  some  large  data  structures 
that  are  slightly  modified  and  duplicated  in  a  very  recursive  and  space  consuming  manner, 
I  have  decided  to  use  additional  linked  lists  to  keep  track  of  additions  and  deletions  at 
each  level  of  recursion.  By  keeping  track  of  just  the  "changes"  This  will  turn  an  N  squared 
space  problem  into  one  that  is  linear.  (This  is  shown  to  be  true,  later.) 

2.  So  since  linked  fists  are  used  extensively,  it  pays  to  have  a  single  generic  routine. 
The  implementation  is  thus  hidden  from  the  user.  This  allows  "information-hiding,"  and 
increased  modularity, 

3.  This  code  is  written  using  Donald  Knuth's  WEB  paradigm  for  literate  programming. 
To  compile  and  link  the  code  in  its  present  format  you  will  need  the  Ada  version  of  the 
WEB  tool. 

It  is  available  on-line  via  the  world- wide- web  at  URL: 

http://white.nosc.mil/~evansjr/literate/ 


4.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
see  the  paper  Literate  Programming,  by  Donald  Knuth  in  The  Computer  Journal,  Vol  27, 
No.  2,  1984;  or  the  book  Weaving  a  Program:  Literate  Programming  in  WEB  by  Wayne 
Sewell,  Van  Nostrand  Reinhold,  1989.  Another  good  source  of  information  is  the  Usenet 
group  comp. programming. literate.  It  has  information  on  new  tools  and  Frequently  Asked 
Questions  (FAQs). 

5.  The  program  consists  of  several  packages  that  are  declared  right  now;  each  of  these 
packages  and  either  the  specification  and  the  body  of  the  packages  are  sent  to  a  separate 
file.  The  main  program  itself  is  declared  later.  (Since  the  original  AWEB  package  was 
written  for  Ada  '83,  it  does  not  properly  format  new  Ada  '95  keywords  protected  and 
private  .  We  remedy  using  the  web  format  commands  below. 

format  protected  =  procedure 
format  private  =  procedure 

6.  As  a  way  of  explanation,  each  "Module"  withing  angle  brackets  (<  >)  is  expanded 
somewhere  further  down  in  the  document.  The  trailing  number  you  see  within  the  brackets 
is  where  you  can  find  this  expansion.  It  is  top-down  in  appearance,  and  in  actual  fact. 

7.  All  the  modules  follow  the  same,  top-down  format.  I  will  group  all  the  boiler-plate  into 
one  module,  for  the  compiler,  but  you  will  see  it  with  the  packages,  as  they  are  described. 

( Package  boiler-plate  8 } 
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8.  List  Specification.  This  specification  is  a  modification  of  the  one  presented  in  the 
book  Ada  95  Problem  Solving  and  Program  Design,  by  Michael  Feldman  and  Elliot  B. 
KofFman.  The  implementation  was  left  as  an  exercise  for  the  student. 

(  Package  boiler-plate  8  )  = 

output  to  file  generic.list .ads 

with  TEXTJO; 

use  TEXTJO; 

generic 

type  Element  Type    is    private    ;     {  Any  nonlimited  type  will  do  } 

with  procedure  Display  Element  (Item  :  IN  ElementType); 

with  function  "<"(L1  ,L2  :  Element  Type  )ret  urn  Boolean; 

with  function  "="(L1  ,L2  :  ElementType)retum  Boolean  is  <>; 

package  genericAist  is 

(Specification  of  types  and  variables  visible  from  genericAist  9 )( Specification  of 
procedures  visible  from  genericAist   12 )  private 

{  Specification  of  private  types  and  variables  in  genericAist  10  ) 
end  genericAist] 

output  to  file  generic  list  .adb 

(  Packages  needed  by  genericJist  body  32  ) 
package  body  genericAist  is 

( Variables  local  to  genericAist  30 ) 

(Procedures  and  Tasks  in  genericAist  33) 
end  genericAist] 

This  code  is  used  in  section  7. 

9. 

(  Specification  of  types  and  variables  visible  from  genericAist  9 )  = 

type  list    is    limited    private    ; 

ListEmpty  :  exception; 
This  code  is  used  in  section  8. 

10. 

( Specification  of  private  types  and  variables  in  genericAist  10  )  = 
type  ListNode;  type  ListPtr  is  access  ListNode] 
type  ListNode  is 
record 

Element  :  ElementType] 
Next  :  ListPtr; 
end  record; 
See  also  section  11. 
This  code  is  used  in  section  8. 
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11.      Added  Size  field  to  original  code. 

(  Specification  of  private  types  and  variables  in  genericJist   10  )  += 
type  List  is 
record 

Size  :  Natural] 
Head  :  ListPtr] 
Tail  :  ListPtr] 
Current  :  ListPtr] 
Previous  :  ListPtr] 
end  record; 

12. 

(  Specification  of  procedures  visible  from  genericJist   12  )  = 

function  ListSize(L  :  in  List)return  natural] 
See  also  sections  13,  14,  15,  16,  17,  18,  19,  20,  21,  22,  23,  24,  25,  26,  27,  and  28. 
This  code  is  used  in  section  8. 

13.      Returns  True  if  L  is  empty,  False  otherwise. 

(  Specification  of  procedures  visible  from  genericJist  12  )  += 
function  IsEmpty(L  :  IN  List)RETURN  Boolean] 

14. 

Pre:  Element  is  defined;  L  may  be  empty. 
Post:  Element  is  inserted  at  the  beginning  of  L. 

(Specification  of  procedures  visible  from  genericJist  12)  += 

procedure  AddToFront(L  :  in  out  List]  Element  :  in  ElementType); 

15. 

Pre:  L  is  defined;  L  may  be  empty. 

Post:  returns  a  complete  copy  of  the  list  L. 

Raises:  ListEmpty  if  the  list  is  empty  before  the  retrieval. 

(  Specification  of  procedures  visible  from  genericJist  12 }  += 
function  RetrieveFront(L  :  in  Zi.si)return  ElementType] 

16. 

Pre:  L  is  defined;  L  may  be  empty. 

Post:  The  first  node  of  L  is  removed. 

Raises:  ListEmpty  if  the  fist  is  empty  before  the  removal. 

{  Specification  of  procedures  visible  from  genericJist  12 )  += 
procedure  RemoveFront(L  :  in  out  List)] 


101 


LIST  SPECIFICATION  Appendix  D         §17 

17. 

Pre:  L  is  defined. 
Post:  L  is  empty. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 
procedure  MakeEmpty(L  :  in  out  List); 

18. 

Pre:  Element  is  defined;  L  may  be  empty. 
Post:  Element  is  appended  to  the  end  of  L. 

(  Specification  of  procedures  visible  from  genericJist  12 }  += 

procedure  AddToEnd(L  :  in  out  List ;  Element  :  in  ElementType); 

19. 

Pre:  Source  may  be  empty. 

Post:  Returns  a  complete  copy  of  Source  in  Target. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 
procedure  Copy  {Source  :  in  List;  Target  :  out  List); 

20. 

Pre:  L  may  be  empty. 

Post:  displays  the  contents  of  L's  Element  fields,  in  the 

order  in  which  they  appear  in  L. 

(Specification  of  procedures  visible  from  genericJist  12)  += 
procedure  Display  (L  :  IN  List); 

21. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 

procedure  InsertInOrder(L  :  in  out  List;  Element  :  ElementType); 

22. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 

procedure  GetNext(L  :  in  out  List;  Element  :  out  ElementType); 

23. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 
procedure  Delete Current(L  :  in  out  List); 

24. 

(Specification  of  procedures  visible  from  genericJist  12)  += 

procedure  DeleteMatching{L  :  in  out  List;  Element  :  in  ElementType;  success  :  out 
boolean); 
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25. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 

procedure  GetCurrent{L  :  in  List ;  Element  :  out  Element  Type); 

26. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 

procedure  Update  Current  (L  :  in  List ;  Element  :  in  ElementType); 

27. 

(  Specification  of  procedures  visible  from  genericJist  12 )  += 

procedure  GetNth(L  :  in  out  List;N  :  in  natural;  Element  :  out  ElementType); 

28. 

(Specification  of  procedures  visible  from  genericJist  12)  += 
procedure  Rewind (L  :  in  out  List); 
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29.     List  Body. 

30. 

(Variables  local  to  genericAist  30 )  = 

debug  :  boolean  <—  false; 
See  also  section  31. 
This  code  is  used  in  section  8. 

31. 

( Variables  local  to  genericAist  30 )  += 

procedure  Dispose  is  new  unchecked- deallocation  (Object  =>  ListNode , 

Name  =>•  ListPtr); 
package  naLio  is  new  integerAo (natural); 

32. 

( Packages  needed  by  genericJist  body  32 )  = 

with  unchecked. deallocation; 

with  U strings; 

use  U strings; 
This  code  is  used  in  section  8. 

33. 

( Procedures  and  Tasks  in  genericAist  33  )  = 

function  ListSize(L  :  in  Zwi)return  Natural  is 

begin 

return  L.Size; 

end  ListSize ; 
See  also  sections  34,  35,  36,  37,  38,  39,  40,  41,  42,  43,  44,  45,  46,  47,  48,  and  49. 
This  code  is  used  in  section  8. 

34.      Returns  True  if  L  is  empty,  False  otherwise. 

(Procedures  and  Tasks  in  genericAist  33)  -f= 

function  IsEmpty(L  :  IN  List)RETURN  Boolean  is 
begin 

if  ListSize(L)  —  0  then 

return  True; 
else 

return  False ; 
end  if; 
end  IsEmpty; 
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35. 

Pre:  Element  is  defined;  L  may  be  empty. 
Post:  Element  is  inserted  at  the  beginning  of  L. 

(  Procedures  and  Tasks  in  genericJist  33  )  += 

procedure  AddTo Front (L  :  in  out  List]  Element  :  in  ElementType)  is 

Temp  :  ListPtr] 
begin 

Temp  <—  new  ListNode]    Temp  .all.  Element  <—  Element;   Temp. all.  Next  <—  L.Head] 

L.Head  <—  Temp]  L.Size  <—  L.Size  +  1; 

if  L.Size  —  1  then 
L.Tail  «-  L.Head] 

end  if; 
end  AddToFront] 

36. 

Pre:  £  is  defined;  L  may  be  empty. 

Post:  returns  a  complete  copy  of  the  fist  L. 

Raises:  ListEmpty  if  the  list  is  empty  before  the  retrieval. 

( Procedures  and  Tasks  in  generic-list  33 )  += 

function  RetrieveFront(L  :  in  List)vetum  ElementType  is 

Temp  :  ListPtr] 
begin 

if  L.Head  =  null  then 

raise  ListEmpty; 
else     {  L.Head  points  to  a  node;  remove  it  } 
Temp  <—  L.Head;  return  Temp  .Element] 
end  if; 
end  RetrieveFront] 
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37. 

Pre:  L  is  defined;  L  may  be  empty. 

Post:  The  first  node  of  L  is  removed. 

Raises:  ListEmpty  if  the  list  is  empty  before  the  removal. 

(Procedures  and  Tasks  in  generic-list  33)  += 
procedure  RemoveFront(L  :  in  out  List)  is 

Temp  :  ListPtr] 
begin 

if  L.Head  =  null  then 

raise  ListEmpty; 
else     {  L.Head  points  to  a  node;  remove  it  } 

Temp  <—  L.Head;  L.Head  <—  L.Head  .all.  Next]     {jump  around  first  node} 
Dispose  (X  =>•  Temp)]  L.Size  <—  L.Size  —  1; 
end  if; 
end  RemoveFront] 

38. 

(  Procedures  and  Tasks  in  generic-list  33  )  += 
procedure  MakeEmpty(L  :  IN  OUT  List)  is 

ptr  :  ListPtr; 
begin 

While  L.Head  ^  null  loop 

RemoveFront  (L)] 
end  loop; 

L.Size  <—  0;  L.Tail  <—  null; 
end  MakeEmpty] 
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39. 

Pre:  Element  is  defined;  L  may  be  empty. 
Post:  Element  is  appended  to  the  end  of  L. 

(  Procedures  and  Tasks  in  generic-list  33  )  += 

procedure  AddToEnd(L  :  IN  OUT  List; Element  :  IN  ElementType)  is 

ptr  :  ListPtr; 
begin 

if  debug  then 

pM<("AddToEnd>uAddingutouenduofulist  :un);   Display  Element  (Element); 
end  if; 
if  L.Head  =  null  then 

L.Tail  <—  new  ListNode' (Element,  null);  L.Head  <—  L.Tail] 
else 

ptr  <—  new  ListNode' (Element,  null);  L.Tail. all. next  <—  ptr;  L.Tail  <—  ptr; 
end  if; 

L.Size  <—  L.Size  +  1; 
end  AddToEnd; 

40. 

Pre:  Source  may  be  empty. 

Post:  Returns  a  complete  copy  of  Source  in  Target. 

(  Procedures  and  Tasks  in  generic-list  33  )  += 

procedure  Copy  (Source  :  in  List;  Target  :  out  List)  is 

ptr  :  listptr; 
begin 

ptr  <—  Source. head;  MakeEmpty (Target); 
while  ptr  ^  null  loop 

AddToEnd  (Target,  ptr.  all.  element);  ptr  <—  ptr  .all. next; 
end  loop; 
end  Copy; 
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41. 

Pre:  L  may  be  empty. 

Post:  displays  the  contents  of  X's  Element  fields,  in  the 

order  in  which  they  appear  in  L. 

(  Procedures  and  Tasks  in  generic-list  33  )  -f= 
procedure  Display  (L  :  IN  List)  is 

ptr  :  ListPtr; 
begin 

if  debug  then 

puLLine  (nDisplay>M ); 
end  if; 

ptr  <—  L.Head; 
while  ptr  ^  null  loop 

Display Element  (ptr  .all.  Element);  ptr  <—  ptr  .all.  Next; 
end  loop; 
end  Display; 
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42. 

( Procedures  and  Tasks  in  generic-list  33 )  += 

procedure  LnsertInOrder(L  :  in  out  List ;  Element  :  ElementType)  is 
Current  :  ListPtr; 
Previous  :  ListPtr; 
Temp  :  ListPtr; 
begin 

if  debug  then 

put (" Insert InOrder>");  put-Line ("Youruinputulistuis:uM );   display (L); 

put (" Insert InOrder>");  put-Line  ("Youruinputuelementuis:u"); 

display  element  (Element); 
end  if; 
if  L.Head  =  null  then 

AddToFront  (L,  Element); 
elsif  Element  <  L.Head  .all. Element  then 

AddToFront  (L,  Element); 
elsif  (L.  Tail. all. Element  <  Element)  V  (L.Size  —  1)  then 

AddToEnd(L,  Element); 
else 

if  L.size  =  1  then 

puL/me("InsertInOrder>uShouldunotubeuhere!  ");  raise  ListEmpty ; 

end  if; 

Temp  <—  new  Zj.sfJVode^.E/emen^null);  Previous  <—  L.Head; 

Current  <—  Previous. all. next; 

while  Current  .all.  element  <  Element  loop 

Previous  <—  Current;    Current  <—  Current  .all. next; 

end  loop; 

Temp. all. nezi  <—  Current;  Previous  .all. next  <—  Temp;  L.Size  <—  L.Size  +  1; 
end  if; 
if  debug  then 

pu<  ("  Insert  InOrder>");  puLXme("Youruinputulistuisunow:u");   display (L); 
end  if; 
end  InsertlnOrder ; 
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43.  Must  be  used  with  ListSize  and  Rewind  or  you  will  never  know  when  you  are  at  the 
end  of  the  list. 

(  Procedures  and  Tasks  in  generic-list  33  )  -+-= 

procedure  GetNth(L  :  in  out  List]N  :  in  natural;  Element  :  out  ElementType)  is 
begin 

if  debug  then 

pu*(nGetNth>uGettingu");  naLio.put(N,  1);  put("  'thurecordu=>M); 
end  if; 
if  L.Head  =  null  then 

raise  ListEmpty; 
elsif  N  >  L.Size  then 

raise  ListEmpty; 
elsif  N  —  1  then 

L. Current  <—  L.Head]  L. Previous  <—  L.Tail; 
else 

Rewind  (L); 

for  i  G  2  . .  N  loop 

L. Previous  <—  L. Current]  L. Current  <—  Zy.Currenf.all.nesf; 
end  loop; 
end  if; 

Element  <—  L. Current. all. element] 
if  debug  then 

Display  Element  (Element)] 
end  if; 
end  GetNth] 

44.  Must  be  used  with  ListSize  and  Rewind  or  you  will  never  know  when  you  are  at  the 
end  of  the  list. 

(  Procedures  and  Tasks  in  generic-list  33  )  += 

procedure  GetCurrent(L  :  in  List]  Element  :  out  ElementType)  is 
begin 

if  L.Head  =  null  then 

raise  ListEmpty; 
end  if; 

Element  <—  X.  Current  .all.  element] 
end  GetCurrent] 
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45.      Must  be  used  with  ListSize  and  Rewind  or  you  will  never  know  when  you  are  at  the 
end  of  the  list. 

(  Procedures  and  Tasks  in  genericJist  33  )  += 

procedure  Update  Current  (L  :  in  List]  Element  :  in  ElementType)  is 
begin 

if  L.Head  =  null  then 

raise  ListEmpty; 
end  if; 

L. Current. all. element  <—  Element] 
end  Update  Current; 

46. 

(  Procedures  and  Tasks  in  generic-list  33  )  += 
procedure  Delete  Current(L  :  in  out  List)  is 

Temp  :  ListPtr] 
begin 

if  L.Head  =  null  then 

raise  ListEmpty; 
elsif  L.Size  =  1  then 

Temp  <—  L. Current]  L. Current  <—  null;  L. Previous  <—  null;  L.Head  <—  null; 
L.  Tai/  «-  null; 
else 

Temp  <—  L. Current] 

if  L.  Current  =  L.Tail  then 

L. Previous  .all. nezf  <—  L. Current. all.next]  L. Current  <—  L.Head] 
L.  Tail  <—  L. Previous ; 
elsif  L. Current  =  L.Head  then 

L. Current  <—  L. Current. all. JVez<;     {jump  around  current  node} 
L.Head  <—  L. Current] 
else 

L. Previous  .all.next  <r-  L. Current. all.next]  L. Current  <—  X. Current. all. Next] 
{  jump  around  current  node  } 
end  if; 
end  if; 
if  debug  then 

pM<("DeleteCurrent>Deleting=>M);   DisplayElement(Temp . all. Element); 
end  if; 

Dispose(X  =>  Temp)]  L.Size  <—  L.Size  —  1; 
end  Delete  Current; 
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47. 

(  Procedures  and  Tasks  in  generic-list  33  )  -}-= 

procedure  DeleteMatching(L  :  in  out  List]Element  :  in  ElementType]  success  :  out 
boolean)  is 
kntr  :  natural] 
Current  :  ElementType; 
begin 

success  <—  false; 

if  L.Head  =  null  then 

raise  ListEmpty, 
end  if; 

Rewind  (L);  kntr  <—  L.Size; 
for  i  £  1  ..  fcnir  loop 
GetNext(L,  Current); 
if  Current  —  Element  then 

DeleteCurrent(L);  success  <—  true;  exit; 
end  if; 
end  loop; 
end  DeleteMatching; 

48. 

( Procedures  and  Tasks  in  genericJist  33 )  -\-= 
procedure  Rewind (L  :  in  out  List)  is 
begin 

L. Current  <—  L.Head]  L. Previous  <—  L.Tail] 
end  Rewind] 

49.      Must  be  used  with  ListSize  and  Rewind  or  you  will  never  know  when  you  are  at  the 
end  of  the  list. 

(Procedures  and  Tasks  in  genericJist  33)  += 

procedure  GetNext(L  :  in  out  List]  Element  :  out  ElementType)  is 
begin 

if  L.Head  =  null  then 

raise  ListEmpty] 
elsif  L. Current  =  L.Tail  then 

L. Current  <—  L.Head]  L. Previous  <—  L.Tail] 
else 

L. Previous  <—  L. Current]  L. Current  <—  L. Current. all. next] 
end  if; 

Element  <—  L. Current. all. element] 
end  GetNext; 
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50.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

51.  RCS  Keywords. 

$RCSfile:  list.aweb,v 

$Revision:  1.4 

$Date:  1997/08/06  16:54:30 

$  Author:  evansjr 

$Id:  list.aweb,v  1.4  1997/08/06  16:54:30  evansjr  Exp  evansjr 

$Locker:  evansjr 
$State:  Exp 
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52.  Index.  Here  is  a  cross-reference  table  for  the  MAIN  program.  All  modules  in  which 
an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are  indexed 
only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers  in  module 
names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  correspond  to 
sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond  to  the 
section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


AddToEnd:     18,  39,  40,  42. 

AddToFront:     14,  35,  42. 

boolean:     24,  30,  47. 

Boolean:     8,  13,  34. 

Copy:     19,  40. 

Current:     11,  42-49. 

debug:     30,  39,  41-43,  46. 

Delete  Current:     23,  46,  47. 

DeleteMatching:     24,  47. 

display :     42. 

Display:     20,  41. 

Display  Element:     8,  39,  41,  43,  46. 

display  element:     42. 

Dispose  :     31,  37,  46. 

element:     40,  42-45,  49. 

Element:     10,  14,  18,  20-22,  24-27, 

35-36,  39,  41-47,  49. 
ElementType:     8,  10,  14-15,  18,  21-22, 

24-27,  35-36,  39,  42-45,  47,  49. 
False:     13,  34. 
false:     30,  47. 
generic-list:     8. 
generic_list .adb  :     8. 
generic.list .ads :     8. 
GetCurrent:     25,  44- 
GetNext:     22,  47,  49. 
GetNth:     27,  43. 
Head:     11,  35-39,  41-49. 
head:     40. 
i:     43,  47. 

IN:     8,  13,  20,  34,  38-39,  41. 
InsertlnOrder:     21,  42. 
integer Ao:     31. 
IsEmpty:     13,  34. 
Item:     8. 


kntr:     47. 

List:     11,  12-28,  33-49. 

list:     9. 

ListEmpty:     9,  15-16,  36-37,  42-47,  49. 

ListNode:     10,  31,  35,  39,  42. 

ListPtr:     10,  11,  31,  35-39,  41-42,  46. 

listptr:     40. 

ListSize :     12,  33,  34,  43-45,  49. 

LI:     8. 

L2:     8. 

MakeEmpty:     17,  38,  40. 

Name:     31. 

naLio:     31,  43. 

natural:     12,  27,  31,  43,  47. 

Natural:     11,  33. 

Next:     10,  35,  37,  41,  46. 

next:     39-40,  42-43,  46,  49. 

Object:     31. 

OUT:     38-39. 

Previous:     11,42-43,46,48-49. 

private:     5. 

procedure:     5. 

protected:     5. 

ptr:     38-41. 

put:     39,  42-43,  46. 

puLLine :     41-42. 

puLline:     42. 

RemoveFront:     16,  37,  38. 

RetrieveFront:     15,  36. 

RETURN:     13,  34. 

Rewind:     28,43-45,47,48,49. 

size :     42. 

Size :     11,  33,  35,  37-39,  42-43,  46-47. 

Source:     19,  40. 

success :     24,  47. 
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system  dependencies:     50. 

Tail:     11,  35,  38-39,  42-43,  46,  48-49. 

Target:     19,  40. 

Temp:     35-37,  42,  46. 

TEXTJO:     8. 

true:     47. 

True:     13,  34. 

unchecked- deallocation:     31-32. 

Update  Current:     26,  45. 

U strings:     32. 

While:     38. 

with:     8. 
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(  Package  boiler-plate  8  )      Used  in  section  7. 

(  Packages  needed  by  genericJist  body  32  )     Used  in  section  8. 

( Procedures  and  Tasks  in  genericJist  33,  34,  35,  36,  37,  38,  39,  40,  41,  42,  43,  44,  45,  46,  47,  48, 

49  )      Used  in  section  8. 
(  Specification  of  private  types  and  variables  in  genericJist  10,  11 }     Used  in  section  8. 
( Specification  of  procedures  visible  from  genericJist  12,  13,  14,  15,  16,  17,  18,  19,  20,  21,  22, 

23,  24,  25,  26,  27,  28  )       Used  in  section  8. 
(  Specification  of  types  and  variables  visible  from  genericJist  9 )     Used  in  section  8. 
( Variables  local  to  genericJist  30,  31 )     Used  in  section  8. 
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§         APPENDIX  E  INTRODUCTION 

1.  Introduction.  This  package  computes  federal  holidays,  and  off-fridays  for  NRaD. 
(We  work  five  days  one  week,  four  the  next — nine  hours  a  day,  except  for  Fridays.)  The 
input  is  just  the  year.  If  you  do  not  work  the  5/4  weeks  then  there  is  a  switch  (-nps  true) 
that  you  can  use  to  turn  it  off. 

2.  This  is  based  on  a  C  program  calyr,  written  by  Bob  Hall  of  Nrad  in  the  eighties. 
Bob  was  a  brilliant,  and  prolific  programmer  at  NRaD  who  retired  in  the  early  nineties. 
One  of  his  programs  msgs,  formed  the  basis  of  Eudora,  a  popular  mail  tool  for  PC's  and 
Macintoshes,  and  now  owned  by  Qualcomm. 

3.  This  program  was  written  to  work  for  dates  after  1970.  It  should  work  till  the  year 
2099.  (A  year  3000  problem!)  To  test  it  out  compile  the  driver  program  and  run  it  with 
the  following  command  line: 

main    [-year   <year>]    [-nps   <boolean>] 

For  example: 

main  -year  1993  -nps  false 

4.  This  code  is  written  using  Donald  Knuth's  WEB  paradigm  for  literate  programming. 
To  compile  and  link  the  code  in  its  present  format  you  will  need  the  Ada  version  of  the 
WEB  tool. 

It  is  available  on-line  via  the  world-wide-web  at  URL: 

http://white.nosc.mil/~evansjr/Uterate/ 


5.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
see  the  paper  Literate  Programming,  by  Donald  Knuth  in  The  Computer  Journal,  Vol  27, 
No.  2,  1984;  or  the  book  Weaving  a  Program:  Literate  Programming  in  WEB  by  Wayne 
Sewell,  Van  Nostrand  Reinhold,  1989.  Another  good  source  of  information  is  the  Usenet 
group  comp. programming. literate.  It  has  information  on  new  tools  and  Frequently  Asked 
Questions  (FAQs). 

6.  The  program  consists  of  several  packages  that  are  declared  right  now;  each  of  these 
packages  and  either  the  specification  and  the  body  of  the  packages  are  sent  to  a  separate 
file.  The  main  program  itself  is  declared  later.  (Since  the  original  AWEB  package  was 
written  for  Ada  '83,  it  does  not  properly  format  new  Ada  '95  keywords  protected  and 
private  .  We  remedy  using  the  web  format  commands  below. 

format  protected  =  procedure 
format  private  =  procedure 
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7.  As  a  way  of  explanation,  each  "Module"  withing  angle  brackets  (<  >)  is  expanded 
somewhere  further  down  in  the  document.  Consider  it  a  high-level  PDL  (Program  De- 
scriptor Language).  The  trailing  number  you  see  within  the  brackets  is  where  you  can  find 
this  expansion.  It  is  top-down  in  appearance,  and  in  actual  fact. 

8.  All  the  modules  follow  the  same,  top-down  format.  I  will  group  all  the  boiler-plate  into 
one  module,  for  the  compiler,  but  you  will  see  it  with  the  packages,  as  they  are  described. 

( Package  boiler-plate  9 ) 
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9.      Calyr  Specification. 

(  Package  boiler-plate  9  )  = 
output  to  file  calyr. ads 

■with  V strings; 

use  Ustrings ; 

with  TEXTJO; 

use  TEXTJO; 

with  Ada  .Comman(LLine ; 

use  Ada  .Command-Line; 

with  Ada. Calendar; 

use  Ada. Calendar; 

package  calyr  is 

( Specification  of  types  and  variables  visible  from  calyr  11 } 

(  Specification  of  procedures  visible  from  calyr  16  ) 
end  calyr; 

output  to  file  calyr. adb 

(  Packages  needed  by  calyr  body  10  ) 
package  body  calyr  is 

(  Types  local  to  calyr  57 ) 

( Variables  local  to  calyr  33  ) 

(  Local  Procedures  59  ) 

(  Procedures  and  Tasks  in  calyr  39  ) 
end  calyr; 
This  code  is  used  in  section  8. 

10. 

( Packages  needed  by  calyr  body  10 )  = 

with  text-io; 

use  text-io; 
See  also  section  32. 
This  code  is  used  in  section  9. 

11. 

( Specification  of  types  and  variables  visible  from  calyr  11 )  = 

subtype  Hour-Number  is  integer  range  0  . .  23; 

subtype  Minute-Number  is  integer  range  0  . .  59; 

subtype  Second-Number  is  integer  range  0  . .  59; 
See  also  sections  12,  13,  14,  and  15. 
This  code  is  used  in  section  9. 
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12. 

(  Specification  of  types  and  variables  visible  from  calyr  11 )  +  = 
BadYear  :  Exception; 
BadDay  :  Exception; 

type  fourarray  is  array  (0  . .  3)  of  integer; 
type  threearray  is  array  (0  . .  2)  of  integer; 

13. 

(  Specification  of  types  and  variables  visible  from  calyr  11 )  += 

type  month  is  (Jan,  Feb, Mar ,  Apr , May  ,Jun,  Jul,  Aug,  Sep ,  Oct,  Nov,  Dec); 
type  DayOfWeek  is  (Sun,Mon,  Tue,  Wed,  Thu,Fri,Sat); 

14. 

(  Specification  of  types  and  variables  visible  from  calyr  11 )  += 
subtype  WeekDay  is  DayofWeek  range  Mon  ..  Fri; 

15. 

(  Specification  of  types  and  variables  visible  from  calyr  11 )  += 
Type   WorkHours  is  array  (  WeekDay )  of  Duration ; 

16. 

(  Specification  of  procedures  visible  from  calyr  16 )  = 

procedure  print-holidays  (yr  :  in  Year-Number;  do^nps  :  in  boolean); 
See  also  sections  17,  18,  19,  20,  21,  22,  23,  24,  25,  26,  27,  28,  29,  and  30. 
This  code  is  used  in  section  9. 

17.      Given  a  date  (in  Ada  time  format),  hoLdy  returns  any  special  info  about  it. 

status  return  values:    0  not  a  special  day 

1  a  non-work  holiday 

2  observation  of  a  non-work  holiday 

3  other  special  day  (not  non-work) 

4  an  off- Friday  or  Thursday 
di  return  values:            di[0]  weekday  of  holiday  (0  to  6) 

di[l]  day  identification  index 

di[2]  2:  off-Friday;  1  :  off- Thursday 

0:  not  an  offday 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

procedure  hoLdy(yrdate  :  time;di  :  out  threearray ;  status  :  out  integer); 
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18.  This  function  was  taken  from  the  book  Numerical  Recipes.  It  actually  works  on  any 
year,  not  the  artificial  limit  imposed  by  Ada  type  Year-Number  (1901  . .  2099). 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

function  Julian-  day  (Month  :  Month-Number;  Day  :  Day-Number]  Year  :  Integer)return 
long-integer; 

19.  This  procedure  calculates  the  Month,  Day,  and  Year  when  given  the  Julian-day . 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

procedure  caldate (Julian  :  Long-integer;  Month  :  out  Month-Number;  Day  :  out 
Day-Number;  Year  :  out  Integer); 

20.  Computes  whether  this  is  an  off-day  or  a  work-day. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

function  IsWorkDay(YrDate  :  Time;NRaD  :  boolean  <—  false; 
debugit  :  boolean  <—  /a/.»e)return  boolean; 

21.  Function  aid  computing  new  dates  based  on  work  hours. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

function  DurationToCalendarTime(StartDate  :  Time ;  dailyhours  :  WorkHours; 
hrs  :  Duration;  NRaD  :  boolean  )return  Time; 

22.  Inverse  of  above. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

function  CalendarTimeToDuration(StartDate  :  Time ;  dailyhours  :  WorkHours; 
EndDate  :  Time;  NRaD  :  boolean )return  Duration; 

23. 

(  Specification  of  procedures  visible  from  calyr  16 )  -\-= 

function  SameDay(Timel ,  Timet  :  Time )return  boolean; 

24. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

function  GetDayOfWeek(Today  :  Time )return  DayOfWeek; 

25.  Straightforward  transformation. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

function  ConvertHoursToDuration(hrs  :  na£ura/)return  Duration; 

26.  Inverse  of  previous. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

function  ConvertDurationToHours(dur  :  Duration)retum  natural; 
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27. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 

Procedure  Split(Seconds  :  Day-Duration;  Hour  :  out  Hour-Number;  Minute  :  out 
Minute-Number;  Second  :  out  Second. Number)] 

28. 

(  Specification  of  procedures  visible  from  calyr  16 )  -\~= 
procedure  print- date  (date  :  time); 
procedure  prinLdate(outfile  :  file-type]  date  :  time); 

29. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 
function  get-date (str  :  in  Ustring ^return  Time; 
function  get-date (infile  :  file-type )return  Time; 

30.      Adds  one  day  to  the  input  parameter. 

(  Specification  of  procedures  visible  from  calyr  16 )  += 
function  IncrementDay(  YrDate  :  Tzme)return  Time; 
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31.      Calyr  Body. 

32. 

(Packages  needed  by  calyr  body  10 )  += 

■with  Ada.  Strings.  Unbounded;   Use  Ada  .Strings  .Unbounded ;  with  Ustrings; 
use  Ustrings ; 

33.  Number  days  in  the  month. 

( Variables  local  to  calyr  33 )  = 

ndm  :  array  (Month-Number)  of  natural  <-  (31,28,31,30,31,30,31,31,30,31,30,31); 
See  also  sections  34,  35,  36,  37,  38,  46,  48,  49,  50,  58,  and  65. 
This  code  is  used  in  section  9. 

34.  Last  day/previous  month. 

( Variables  local  to  calyr  33 )  += 

Idpm  :  array  (Month-Number)  of  natural  *-  (0,31,59,90,120,151,181,212,243,273, 
304,334); 

35.  List  of  holidays. 

( Variables  local  to  calyr  33 )  += 

NumHolidays  :  constant  natural  *—  20; 

holidays  :  constant  array  (1  ..  NumHolidays)  of  Ustring  <—  (Z7("NewuYear 'suDay"), 
C/"("MLuKinguDay"  ),  ^("Presidents  'uDayM ),  Ef  ("MemorialuDay" ), 
C/("IndependeiiceuDay,,),C/'(,,LaboruDay"),t/(,,ColumbusuDay"), 
C7(MVeterans'uDayM),f/("ThanksgiviiiguDayM),17("ChristmasuDayM), 
^("Valentine'suDay'^^C'StuPatrick'suDay'^^CGooduFriday"), 
[/"("Easter"),  tf  ("Mothers  'uDay" ),  *7("ArmeduForcesuDay" ),  £/("FlaguDay" ), 
[/("Fathers  'uDay" ),  [/("Halloween" ),  [/("ElectionuDay" )); 
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36.      Index  of  Holidays. 

( Variables  local  to  calyr  33 )  += 
JNYD  :  constant  integer  <—  1; 
JMLK  :  constant  integer  <—  2; 
JPRS  :  constant  integer  <—  3; 
JMEM  :  constant  integer  <—  4; 
JIND  :  constant  integer  <—  5; 
JLAB  :  constant  integer  *—  6; 
JCOL  :  constant  integer  <—  7; 
JVET  :  constant  integer  <—  8; 
JTHX  :  constant  integer  <—  9; 
JCHR  :  constant  integer  *—  10; 
JVAL  :  constant  integer  <—  11; 
JSPT  :  constant  integer  <—  12; 
JGFR  :  constant  integer  <—  13; 
JEST  :  constant  integer  <—  14; 
J  MOT  :  constant  integer  <—  15; 
JAFD  :  constant  integer  <—  16 
JFLG  :  constant  integer  <—  17 
JFAT  :  constant  integer  <—  18 
JHAL  :  constant  integer  *—  19 
JELC  :  constant  integer  <—  20 


37.      Index  of  something. 

(Variables  local  to  ca/yr  33)  += 

:  constant  integer  <—  0; 

:  constant  integer  <—  1; 

constant  integer  <—  1; 

constant  integer  <—  1; 


/PA5  : 

7£5T  : 
/MEM 
/COZ: 
7F£T 


constant  integer  <—  2; 

:  constant  integer  <—  2; 

constant  integer  <—  0; 

constant  integer  <—  1; 
IHAL  :  constant  integer  <—  2; 
IELC  :  constant  integer  <—  0; 


{index  for  NEW  YEAR'S  DAY,  etc. } 
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38. 

(  Variables  local  to  calyr  33  )  += 
debug  :  boolean  <—  false; 
debug2  :  boolean  <—  false; 
verbose  :  boolean  <—  true; 
nps  :  boolean  <— false; 
already-leaped  :  boolean  «—  false; 
package  int-io  is  new  integerAo (integer); 
use  mLio; 

39. 

( Procedures  and  Tasks  in  calyr  39 )  = 

procedure  hoLdy(yrdate  :  time;  di  :  out  threearray ;  status  :  out  integer)  is 

( Types  and  Variables  local  to  hoLdy  41 ) 
begin 

(  Parse  date  40  ) 
(  Check  if  leap  year  42  ) 
(  Set  year  43 ) 
(  Set  month  63  ) 

(  Loop  over  holidays  and  Off- Fridays  67  ) 
end  hoLdy; 
See  also  sections  81,  88,  93,  101,  109,  118,  129,  131,  132,  133,  134,  136,  137,  139,  141,  and  143. 
This  code  is  used  in  section  9. 

40. 

( Parse  date  40  )  = 

Split(yrdate  ,  Year ,  Month ,  Day ,  Seconds);  hmn  <—  Calyr  .month'  val  (Month  —  1); 
status  <-  0;   di(0)  <-  0;   di(l)  <-  0;  di(2)  <-  0; 

This  code  is  used  in  section  39. 

41. 

( Types  and  Variables  local  to  hoLdy  41 )  = 

Year  :  Year-Number; 

Month  :  Month-Number; 

Day  :  Day-Number; 

Seconds  :  Day-Duration; 

hmn  :  Calyr  .Month; 
See  also  sections  45,  64,  68,  and  71. 
This  code  is  used  in  section  39. 


127 


CALYR  BODY  APPENDIX  E         §42 

42.  Simple-minded  check.  Must  later  look  up  what  to  do  at  end  of  century. 

(  Check  if  leap  year  42  )  = 

if  ((  Year  mod 4)  =  0)  A  (-> already- leaped)  then 

already-leaped  <—  true]  ndm(calyr  .month'  pos  (Feb)  +  1)  <—  29; 
for  j  E  3  . .  12  loop 

ldpm(j)  <—  ldpm(j)  +  1; 
end  loop; 
end  if; 

This  code  is  used  in  section  39. 

43.  The  datatype  hoi  must  be  modified  based  on  the  year.  The  following  code  does  just 
that. 

(  Set  year  43  )  = 

(Calculate  weekday  of  Jan  1.  44) 

( Calculate  beginning  date  of  1st  pay  period  in  year  47 ) 

( Update  ML  King  Day  51 ) 

(Update  President's  Day  52) 

( Update  Memorial  Day  53  ) 

( Update  Columbus  Day  54 ) 

(  Update  Veteran's  Day  55 ) 

(  Compute  Easter  56  ) 
This  code  is  used  in  section  39. 

44. 

(Calculate  weekday  of  Jan  1.  44)  = 

jul  :=  Julian^ day (1,1,  Year);    fdy   <—  DayOfWeek'val((jul  +  1)  mod  7); 

jul  :=  Julian,  day  (Month,  Day ,  Year);  di(l)  <—  integer((jul  +  1)  mod  7); 
This  code  is  used  in  section  43. 

45. 

(Types  and  Variables  local  to  hoLdy  41 )  += 
jul  :  long-integer\ 

46.      Make  global. 

( Variables  local  to  calyr  33 )  += 
fdy  :  Day  Of  Week; 


128 


§47         APPENDIX  E  CALYR  BODY 

47.  Funny  C  logic.  Seems  to  work. 

( Calculate  beginning  date  of  1st  pay  period  in  year  47 )  = 
tYear  <—  Year  —  1970;  tmp  <—  {Year  —  1)  rem 4; 
if  trap  —  0  then 

tmp  <—  1; 
else 

tmp  <—  0; 
end  if; 

bpp  <—  (11  —  tYear  —  tmp  —  (t  Year  /A))  rem  14; 
if  bpp  <  1  then 

bpp  <—  bpp  +  14; 
end  if; 

This  code  is  used  in  section  43. 

48.  Make  global. 

(Variables  local  to  calyr  33)  += 
bpp  :  integer; 
tYear  :  integer; 
tmp  :  integer] 

49. 

( Variables  local  to  calyr  33  )  += 
type  hoLtype  is 
record 

dy  :  fourarray ;     {  Day  of  week  or  date  of  holiday  } 
wn  :  fourarray  ;     {  Week  number  (-1  -£  skip  } 
fl  :  fourarray ;     {  1/0  -£  non- work/ work  holiday  } 
ix  :  fourarray ;     {  Index  of  holiday  name  } 
end  record: 
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50.  I  know  this  is  ugly,  but  it  comes  directly  from  C  code. 

(Variables  local  to  calyr  33 )  += 

hoi  :  array  (Month)  of  hoLtype  *-  (({l,DayOfWeek'pos(MON),-l,Q),(0,3,0,0),{l, 
1, 0,0), (JNYD,JMLK, 0,0)), ((14, DayOfWeek'pos(MON),  -1,0), (0,3,0,0),  (0,1, 
0, 0),  (JVAL,JPRS,0, 0)),  ((17, 0, 0,  -1),  (0,  -1,-1,0),  (0, 0, 0, 0),{JSPT ,  JGFR, 
JEST,0)),  ((0,0, 0,-l),(-l, -1,-1,0),  (0,0, 0,0),  {0,  JGFR,  JEST  ,0)), 
((DayOfWeek'pos(SUN),DayOfWeek'pos(SAT),DayOfWeek'pos(MON),-l),(2, 
3, 5, 0), (0, 0, 1, 0), [JMOT,  JAFD ,  JMEM , 0)), ((14, DayOfWeek 'pos{SUN),  -1,0), 
(0, 3, 0, 0),  (0, 0, 0, 0),  ( JFLG ,  JFAT ,  0, 0)),  ((4,  -1,0, 0),  (0, 0, 0, 0),  (1,0, 0, 0),  ( JIND  , 
0,0,0)),((-l,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),((DayO/W^eeifeV5(MOiV), 
-1,0,0),(1,0,Q,0), {1,0,0,0), {JLAB, 0,0, 0)),{(DayOfWeek'pos{MON), 
DayOfWeek'pos(MON),Zl,  -1),(2,-1,0,0),(1, 1,0,0),  {JCOL,JVET ,JHAL,0)), 
((DayOfWeek'pos(TUE),  11,  DayOfWeek' pos{THU), -I),  (-1,0,4,0),  (0,1, 1,0), 
(JELC,  JVET,  JTHX ,  0)),  ((25,  -1,0, 0),  (0, 0, 0, 0),  (1, 0, 0, 0),  (JCHR ,  0, 0, 0))); 

51.  ML  King  Day  became  federal  holiday  in  1986. 

( Update  ML  King  Day  51 )  = 
if  Year  >  1985  then 

hol(JAN).wn(IMLK)  ^  3; 
else 

hol(JAN).wn(IMLK)  ^  -1; 
end  if; 

This  code  is  used  in  section  43. 

52.  President's  day  is  third  Monday  (after  1971). 

(  Update  President's  Day  52  )  = 

hol(Feb).dy(IPRS)  ^-  DayOfWeek' pos(Mon);  hol{Feb).wn(IPRS)  <-  3; 

if  [Year  <  1971)  then 

hol{Feb).dy(IPRS)  +-  22;  hol(Feb).wn(IPRS)  «-  0; 

end  if; 
This  code  is  used  in  section  43. 

53.  Memorial  Day  is  last  Monday  in  May. 

(  Update  Memorial  Day  53 )  = 

hol(May).dy(IMEM)  +-  DayOfWeek' pos(Mon);  hol(May).wn(IMEM)  <-  5; 
This  code  is  used  in  section  43. 
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54.      Columbus  Day  is  second  Monday  in  October.  Did  not  exist  before  1971,  I  guess? 

( Update  Columbus  Day  54  )  = 
hol(Oct).wn(ICOL)  <-  2; 
if  Year  <  1971  then 

hol(Oct).wn(ICOL)  <-  -1; 
end  if; 

This  code  is  used  in  section  43. 

55. 

(  Update  Veteran's  Day  55  )  = 

hol(Oct).wn(IVET)  <-  -1;  hol(Nov).wn(IVET)  «-  0; 

if  Year  <  1978  then 

hol(Oct).wn(IVET)  <-  4;  hol(Nov).wn{IVET)  «-  -1; 

end  if; 
This  code  is  used  in  section  43. 

56.      Calls  the  function  Easter.  Also  computes  Good  Friday. 

(  Compute  Easter  56  )  = 

edt  <—  easter(  Year)',  hol(edt.mn).dy(IEST)  <—  edt.dt;  hol(edt .mn).wn(IEST)  <—  0; 

edt.dt  <—  edt.dt  —  2; 

if  edt.dt  <  1  then 

edt.dt  <—  edt.dt  +  n<im(3);   edt.mn  <—  Mar; 

end  if; 

hol(edt.mn).dy(IGFR)  *-  e^.it;  hol(edt .mn).wn(IGFR)  <-  0; 
This  code  is  used  in  section  43. 

57. 

( Types  local  to  ca/yr  57 )  = 
type  caldat  is 
record 

mn  :  Month] 
dt  :  integer; 
end  record; 

This  code  is  used  in  section  9. 

58. 

(Variables  local  to  calyr  33 )  += 
edt  :  caldat; 
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59.  Here  is  the  function  easter  that  returns  the  day  and  month  Easter  occurs  for  a  given 
year. 

(  Local  Procedures  59  )  = 

function  easter  (Year  :  in  Year_Number)retum  caldat  is 

(  Types  and  variables  local  to  easter  60  ) 
begin 

fde  <-  ndm(l)  +  ndm(2)]   dt.dt  <-  pfm((Year  -  1900)  mod  19); 
if  dt. dt  <  0  then 

dt.mn  «—  Mar;   dt.dt  < dt.dt] 

else 

dt.mn  <—  Apr]  fde  <—  fde  +  ndm(3); 
end  if; 

(  Compute  weekday  for  Paschal  Full  Moon  62 ) 
return  dt] 
end  easter] 
This  code  is  used  in  section  9. 

60.  Here  is  the  Paschal  Full  Moon  table  used  to  find  Easter. 

( Types  and  variables  local  to  easter  60 )  = 

pfm  :  constant  array  (0  ..  18)  of  integer  <-  (14,3,-23,11,-31,18,8,-28,16,5,-25, 
13, 2,  -22, 10,  -30, 17, 7,  -27); 

See  also  section  61. 

This  code  is  used  in  section  59. 

61. 

( Types  and  variables  local  to  easter  60 )  += 
fde  :  integer] 
dt  :  caldat ; 

62.     Easter  is  the  next  Sunday  following  the  Paschal  Full  Moon. 

(  Compute  weekday  for  Paschal  Full  Moon  62 )  = 

fde  ^-  (dt.dt  +fde  -  (8  -  DayOfWeek' pos(fdy)))  rem  7; 
if  fde  <  0  then 

fde  <-  (7  +fde)  rem 7; 
end  if; 

dt.dt  «-  dt.dt  +7  -fde] 
if  dt.dt  >  ndm (month' pos (dt .mn)  +  1)  then 

dt.dt  «—  dt.dt  —  ndm  (month' pos  (dt.mn)  +  1);   dt.mn  <—  month'  succ(dt  .mn)] 
end  if; 

This  code  is  used  in  section  59. 
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63.      Used  to  determine  off-fridays  of  month.  Also,  if  November,  figure  out  election  day. 

(  Set  month  63  )  = 
declare 

Idm ,  ofr ,  ii ,  jj  :  integer ; 
begin 

ofr  < —  bpp  —  2; 
if  ofr  <  1  then 

ofr  <—  ofr  +  14; 
end  if; 

Idm  <—  Idpm(Month)',  ofr  <—  ofr  +  (/dm/14)  *  (14)  -  Idm] 
if  ofr  <  0  then 

ofr  <—  ofr  +  14; 
elsif  ((Month  >l)A(ofr  >  14))  then 

ofr  <—  ofr  —  14; 
end  if; 

ofrdy(0)  <-  tfJV5T;   ofrdy(l)  <-  CWST;   o/Wfy(2)  <-  f/iV5r;   ofrdy  (3)  <-  t/JVST; 
if  ( Fear  >  1979)  then 

j;  ♦-  0; 
loop 

if  ((  Kear  ^  1982)  V  (Montfi  ^  4)  V  (ofr  /  2))  A  (( Year  ^  1980)  V  (Month  ^  1)) 
then 
ofrdy (jj )  <-  ofr;  jj  +-  jj  +1; 
end  if; 

ofr  +—  ofr  +  14;  exit  when  ofr  >  ndm(Month); 
end  loop; 
end  if; 

/dm  <-  (/dm  -  (7  -  DayOfWeek' pos  (fdy)))  rem  7; 
if  /dm  <  0  then 

fdm  <—  (7  +  /dm )  rem  7; 
end  if; 

(  Figure  out  election  day  66 ) 
end; 

This  code  is  used  in  section  39. 

64. 

(Types  and  Variables  local  to  hoLdy  41 )  += 
UNST  :  constant  integer  <—  64; 
jj  :  integer] 
ofrdy  :  fourarray ; 
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65.      Make  global. 

( Variables  local  to  calyr  33 )  += 
fdm  :  integer; 

66. 

( Figure  out  election  day  66 )  = 

if  (hmn  —  Nov)  A  (( Year  rem  2)  =  0)  then 
ii  <-  hol(Nov).dy(IELC)  -fdm  +  1; 
if  ii  <  1  then 
ii  <—  ii  +  7; 
end  if; 
if  ii  <  2  then 

hol{Nov).wn(IELC)^2] 
else 

hol(Nov).wn(IELC)  ♦-  1; 
end  if; 
end  if; 
This  code  is  used  in  section  63. 

67.      Main  part  of  hoLdy . 

( Loop  over  holidays  and  Off- Fridays  67 )  = 
ii  <-  0;  jj  <-  0; 
loop 

(  Check  for  no  more  holidays  69  ) 
if  (hol(hmn).wn(ii)  >  0)  then 

ho  i—  0;   ( Holiday  with  fixed  week  day  or  fixed  date  70 ) 
(  Exhaust  any  earlier  off- Fridays  72  ) 
(  Check  if  off- Friday  moved  back  to  Thursday  73 ) 
( Work,  and  normal  and  Sunday  non-work,  holiday  74 ) 
(  Monday/Friday  extra  day  75  ) 
(  Saturday  non-work  holiday  76  ) 
end  if; 
ii  <—  ii  +  1; 
((ugly))  exit  when  (ii  >  3); 

exit  when  ((hol(hmn).dy(ii)  <  0)  A  (ofrdy(jj)  =  UNST)); 
end  loop; 

(  December  processing  77 ) 
This  code  is  used  in  section  39. 

68. 

(Types  and  Variables  local  to  hoLdy  41 )  -}-= 
ii,  ho  :  integer] 
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69. 

(  Check  for  no  more  holidays  69 )  = 
if  hol(hmn).dy(ii)  <  0  then 

if  (integer (Month)  <  12)  V  (ofrdy(jj)  <  ndm(12))  then 
if  ofrdy(jj)  =  Day  then 
di(2)  «-2; 
if  status  =  0  then 

status  *—  4; 
end  if; 
end  if; 

ij «-  33  +1;  6oto  u^y; 

else 

exit; 
end  if; 
end  if; 

This  code  is  used  in  section  67. 
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70. 

( Holiday  with  fixed  week  day  or  fixed  date  70 )  = 
if  hol(hmn).wn(ii)  >  0  then 

dw  <—  hol(hmn).dy (»»');   date  <—  dw  —  fdm  +  1; 
if  date  <  1  then 

date  <—  date  +  7; 
end  if; 

date  <—  date  +  (7  *  (hol(hmn).wn(ii)  —  1)); 
if  date  >  ndm(Month)  then     {Takes  care  of  Memorial  Day} 

date  «—  (faie  —  7; 
end  if; 
else     {  Holiday  with  fixed  date  } 

date  <—  hol(hmn).dy(ii);   dw  <—  (date  —  (8  —fdm))  rem  7; 
if  dw  <  0  then 

dw  «—  (7  +  dw)  rem  7; 
end  if; 

if  hol(hmn).fl(ii)  >  0  then     {Take  care  of  weekend  holidays} 
if  dw  —  Day  Of  Week' pos  (Sun)  then 

ho  <—  1; 
elsif  dw  =  Day  Of  Week' pos  (Sat)  then 

ho  < 1; 

else 

ho  <-  0; 
end  if; 
end  if; 
end  if; 

This  code  is  used  in  section  67. 

71. 

(Types  and  Variables  local  to  hoLdy  41 )  -f= 
date,dw  :  integer; 
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72. 

(  Exhaust  any  earlier  off- Fridays  72  )  = 

while  ((hol(hmn).fl(ii)  >  0)  A  (({ho  >  0)Aofrdy(jj)  <  date)  V  ((ho  <  0)  A  (ofrdy  (jj )  < 
(date  -  1)))))  V  ((hol(hmn).fl(ii)  =  0)  A  (ofrdy (jj)  <  date))  loop 
if  ofrdy  (jj)  =  Day  then 
<fi(2)<-2; 
if  status  —  0  then 

status  <—  4; 
end  if; 
end  if; 

jj  +-ti  +i; 

end  loop; 

This  code  is  used  in  section  67. 

73. 

(  Check  if  off- Friday  moved  back  to  Thursday  73  )  = 

if  (ofrdy (jj)  >  l)A(hol(hmn).fl(ii)  >  0)A((ofrdy(jj)  =  date)V (ofrdy  (jj )  =  (date+ho))) 
then 
if  (ofrdy (jj)  —  1)  =  Day  then 
di(2)<-l; 
if  status  =  0  then 

status  <—  4; 
end  if; 
end  if; 

jj  «- ;;  +  lj 

end  if; 

This  code  is  used  in  section  67. 

74. 

( Work,  and  normal  and  Sunday  non-work,  holiday  74 )  = 
if  (ho  >  0)  A  (date  =  Day)  then 

di(0)  <—  dw\  di(l)  «—  hol(hmn).ix(ii)\  status  <—  1  +  2  *  (di(l)/JVAL); 
end  if; 

This  code  is  used  in  section  67. 

75. 

(  Monday/ Friday  extra  day  75 )  = 

if  (ho  ^  0)  A  ((date  +  ho)  >  0)  A  ((date  +  ho)  =  Day)  then 

di(0)  <—  dw  +  ho;    di(l)  <—  hol(hmn).ix(ii);  status  <—  2; 
end  if; 

This  code  is  used  in  section  67. 
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76. 

(  Saturday  non-work  holiday  76 )  = 
if  (ho  <  0)  A  (date  =  Day)  then 

di(0)  <—  dw;   di(l)  <—  hol(hmn).ix(ii)\  status  <—  1; 
end  if; 

This  code  is  used  in  section  67. 

77. 

(  December  processing  77 )  = 
if  hmn  =  Dec  then 

( Is  first  of  next  year  a  Friday  or  Saturday  and  this  is  an  off- Friday?  78 ) 

( Weekday  of  December  31  79 ) 

( December  31  a  Friday  the  observe  Saturday,  January  1st  80 )  end  if; 
This  code  is  used  in  section  67. 

78. 

( Is  first  of  next  year  a  Friday  or  Saturday  and  this  is  an  off- Friday?  78  )  = 
if  jj  ^  0  then 

if  (ofrdy(jj)  =  ndm(12))  then 

tmp  <—  1; 
else 

tmp  <—  0; 
end  if; 

if  ((ofrdy (jj -1)  =  (ndm (12) -13))V(ofrdy  (jj)  =  ndm (12))) A((ndm (12) -tmp)  =  Day) 
then 
jK(2)«-l; 
if  status  =  0  then 

status  <—  4; 
end  if; 
end  if; 
end  if; 

This  code  is  used  in  section  77. 

79. 

( Weekday  of  December  31  79  )  = 

dw  <—  (ndm  (12)  -  (8  -  fdm))  rem  7; 
if  dw  <  0  then 

dw  <—  (7  +  dw )  rem  7; 
end  if; 

This  code  is  used  in  section  77. 
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80. 

( December  31  a  Friday  the  observe  Saturday,  January  1st  80 )  = 
if  (dw  =  DayOfWeek'pos(Fri))  A  ndm (12)  =  Day  then 

di(0)  <r-  DayofWeek'pos(Fri);  di(l)  <-  hol(Jan).ix(INYD);  status  «-  2; 
end  if; 

This  code  is  used  in  section  77. 

81. 

(Procedures  and  Tasks  in  calyr  39)  += 

procedure  print-holidays (yr  :  in  Year- Number;  do_nps  :  in  boolean)  is 

( Variables  local  to  print-holidays   84  ) 
begin 

nps  <—  do-nps]   (Loop  through  months  82) 
end  print-holidays ; 

82.      Straightforward. 

(  Loop  through  months  82  )  = 
for  mon  £  Jan  . .  Dec  loop 
if  -^verbose  then 

put  (month' image  (mon))]  />«£(">"); 
end  if; 

(  Loop  through  days  of  month  83 ) 
if  -i verbose  then 

puLline  ("u"); 
end  if; 
end  loop; 
This  code  is  used  in  section  81. 
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83. 

(  Loop  through  days  of  month  83  )  = 

for  ii  €  1  ..  (ndm  (month'  pos  (mon)  +  1))  loop 

hoLdy  (Time-of  (yr ,  month' pos  (mon)  +  1,  ii, 0.0),  di,  status); 
if  -iverbose  then 
if  (status  >  0)  then 

put (" day u=uM);  put(ii,l);  put("  .uustatusu=u");  put  (status,  1); 
pu*(Huudiu=u-C"); 
for  i  G  0  . .  2  loop 
pu£(di(i),i); 
if  i  <  2  then 

jm*(V); 

end  if; 
end  loop; 

puUine("}u")] 
end  if; 
else 

(  Print  out  first  day  of  month  85 ) 
( Print  out  holidays,  as  necessarily  87 ) 
end  if; 
end  loop; 
This  code  is  used  in  section  82. 

84. 

( Variables  local  to  print-holidays   84  )  = 

status  :  integer; 

di  :  threearray ; 
See  also  section  86. 
This  code  is  used  in  section  81. 

85. 

( Print  out  first  day  of  month  85 )  = 
if  ii  =  1  then 

put  (month' image  (mon));  put(ii,3);  put("u");  hfdm  <—  DayOfWeek' val(fdm); 
put(DayOfWeek ' image(hfdm ));  puLline (""); 
end  if; 
This  code  is  used  in  section  83. 

86. 

( Variables  local  to  print-holidays   84 )  += 
hfdm  .DayOfWeek; 
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87. 

( Print  out  holidays,  as  necessarily  87 )  = 
if  status  >  0  then 
if  ->nps  then 

if  (di(2)  >0)  then 

hfdm  <-  Day0fWeek'val(di(2)  +  3);  put(DayOfWeek'image(hfdm));  put(ii,3); 
put("u");  puUine( "Off day"); 
end  if; 
end  if; 
if  status  <  3  then 

hfdm  *—  DayOfWeek'  val(di(0));  put(Day  Of  Week'  image  (hfdm));  put(ii,3); 
put("u")',  put  (S (holidays  (di(l)))); 
if  status  ^  2  then 

puUine("")\ 
else 

put-line  ("u  (Observed)"); 
end  if; 
end  if; 
end  if; 

This  code  is  used  in  section  83. 

88. 

( Procedures  and  Tasks  in  calyr  39 )  += 

procedure  caldate (Julian  :  Long-integer;  Month  :  out  Month-Number;  Day  :  out 
Day-Number;  Year  :  out  Integer)  is 
( Variables  local  to  caldat  90  ) 
begin 

if  (Julian  >  IGREG)  then 

(  Correct  for  to  Gregorian  Calendar  89  ) 
else 

ja  <—  Julian ; 
end  if; 

(  Now  finish  computation  91 ) 
end  caldate ; 

89. 

( Correct  for  to  Gregorian  Calendar  89 )  = 

jalpha  <-  long-integer  (((float  (Julian  -  1867216)  -  0.25)/36524.25)  -  0.5); 

ja  <—  Julian  +  1  +  jalpha  —  long-integer  (0.25  *  float  (jalpha)  —  0.5); 
This  code  is  used  in  section  88. 
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90. 

( Variables  local  to  caldat   90 )  = 

IGREG  :  constant  long-integer  <-  (15  +  31  *  (10  +  12  *  1582)); 

ja,jalpha  :  long-integer; 
See  also  section  92. 
This  code  is  used  in  section  88. 

91. 

(  Now  finish  computation  91 )  = 
jb  <-  ja  +1524; 

jc  <-  longJnteger ((6680.0  +  {float  (jb  -  2439870)  -  122.1  )/365.25)  -  0.5); 
jd  <—  (365  *  jc)  +  long-integer  (0.25  *  float  (jc)  —  0.5); 
je  <—  long-integer  (float  (jb  —  ji)/30.6001  —  0.5); 
Day  <—  Integer(jb  —  jd  —  long-integer  (30.6001  *  float  (je)  —  0.5)); 
TMonth  <—  Integer  (je  —  1); 
if  ( TMonth  >  12)  then 

Month  <—  Tmonth  —  12; 
else 

Month  <—  Tmonth; 
end  if; 

Year  <—  integer  (jc  —  4715); 
if  (Month  >  2)  then 

Year  <—  Year  —  1; 
end  if; 
if  Year  <  0  then 

Year  <—  Year  —  1; 
end  if; 

This  code  is  used  in  section  88. 

92. 

( Variables  local  to  caldat  90 )  += 
jb,jc,jd,je  :  long-integer; 
Tmonth  :  integer; 
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93. 

{  Procedures  and  Tasks  in  calyr  39  )  += 

function  julian-day  (Month  :  Month- Number;  Day  :  Day- Number;  Year  :  Integer )return 
long^integer  is 

( Variables  local  to  Julian-Day  94  ) 
begin 

(  Check  for  bad  year  95  ) 

( Twiddle  some  variables  before  computing  96  ) 

(  Compute  Julian  number  98  ) 

( Test  whether  to  change  to  Gregorian  Calendar  99  ) 

return  jul; 
end  julian-day; 

94. 

( Variables  local  to  Julian-Day  94 )  = 

jul  :  long-integer; 
See  also  sections  97  and  100. 
This  code  is  used  in  section  93. 

95.  There  is  no  year  zero! 

(  Check  for  bad  year  95  )  = 
if  (  Year  =  0)  then 

raise  BadYear; 
end  if; 

This  code  is  used  in  section  93. 

96.  I  translated  this  from  C.  I  don't  pretend  to  understand  it. 

( Twiddle  some  variables  before  computing  96 )  = 
if  Year  <  0  then 

TYear  <—  Year  +  1; 
else 

TYear  <—  Year; 
end  if; 
if  Month  >  2  then 

jy  *—  TYear;  jm  «—  Month  +  1; 
else 

jy  <—  TYear  —  1;  jm  <—  Month  +  13; 
end  if; 

This  code  is  used  in  section  93. 
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97. 

(Variables  local  to  Julian-Day  94)  += 
TYear,jy,jm  :  integer] 

98.  Probably  taken  from  the  book  Astronomical  Formulae  for  Calculators. 

(  Compute  Julian  number  98  )  = 

jul  <—  long-integer  (365.25  *  float  (jy)  —  0.5)  +  long-integer  (30.6001  *  float  (jm)  —  0.5)  + 
long.integer  [Day  +  1720995); 
This  code  is  used  in  section  93. 

99.  Gregorian  Calendar  was  adopted  on  October  15,  1582. 

( Test  whether  to  change  to  Gregorian  Calendar  99 )  = 

if  long-integer  (integer  (Day)  +  31  *  (integer  (Month)  +  12  *  Fear))  >  IGREG  then 

ja  «—  integer(0.01  *  float  (jy)  —  0.5); 

jul  <—  jul  +  long-integer (2  —  ja  +  integer(0.25  *  float(ja)  —  0.5)); 
end  if; 

This  code  is  used  in  section  93. 

100. 

(Variables  local  to  Julian-Day  94)  ■+-= 

IGREG  :  constant  long-integer  <-  (15  +  31  *  (10  +  12  *  1582)); 
ja  :  integer] 
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101. 

(Procedures  and  Tasks  in  calyr  39)  += 

function  IsWorkDay(YrDate  :  Time]NRaD  :  boolean  <—  false] 
debugit  :  boolean  *—  false  )return  boolean  is 
( Variables  local  to  Is  WorKDay   103 ) 
begin 

status  <—  1;  workday  <—  false ;  hoLdy(CurrenLTime,  di, status)] 
if  debugit  then 

(Display  hoLdy  output  102) 
end  if; 

dow  <-  GetDayOfWeek(YrDate)] 
if  status  =  0  then 

( Make  sure  not  a  Saturday  or  Sunday  106 ) 
elsif  nrad  then 

(  Look  if  NraD  off- Friday  (or  off-Thursday  if  Friday  a  holiday)  107 ) 
else 

(  See  if  federal  holiday  108  ) 
end  if; 
if  debugit  then 

(  Print  if  workday  104  ) 
end  if; 

return  workday] 
end  IsWorkDay] 

102. 

(Display  hoLdy  output  102)  = 

Split  {Yrdate  ,  Year ,  Month ,  Day ,  Seconds)]  pui("Statusu=uM);  put  (status,  1)] 

put("uudiu=ui")] 

for  i  6  0  . .  2  loop 

put(di(i),i)] 

if  i  <  2  then 

P«t(V); 

end  if; 
end  loop; 
pii£_7*ne(,,},u,,)i 

This  code  is  used  in  section  101. 
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103. 

( Variables  local  to  Is  WorKDay  103  )  = 

Year  :  Year-Number; 

Month  :  Month-Number-, 

Day  :  Day-Number; 

Seconds  :  Day-Duration; 

dow  :  DayOfWeek; 
See  also  section  105. 
This  code  is  used  in  section  101. 

104. 

(  Print  if  workday  104  )  = 
prints  date  (  Yrdate ); 
if  workday  then 

pwL/me("uisuauworkday . "); 
else 

j?uL/me("uisuN0Tuauworkday. "); 
end  if; 
This  code  is  used  in  section  101. 

105. 

( Variables  local  to  Is  WorKDay  103  )  += 
status  :  integer; 
workday  :  boolean; 
di  :  threearray; 
Current-Time  :  Time  <—  YrDate; 

106. 

(  Make  sure  not  a  Saturday  or  Sunday  106  )  = 

if  (dow  ^  Sun)  A  (dow  ^  Sat)  then 
workday  <—  true; 

end  if; 
This  code  is  used  in  sections  101,  107,  and  108(2). 

107.      Make  allowances  for  people  (NRaD)  working  5/4  weekly  schedule. 

(  Look  if  NraD  off- Friday  (or  off- Thursday  if  Friday  a  holiday)  107 )  = 

if  status  =  3  then 

( Make  sure  not  a  Saturday  or  Sunday  106 ) 

end  if; 
This  code  is  used  in  section  101. 
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108.      If  status  >  2  could  be  Arbor  Day,  or  other  work  holiday. 

(  See  if  federal  holiday  108  )  = 
if  status  —  3  then 

(  Make  sure  not  a  Saturday  or  Sunday  106  ) 
end  if; 
if  status  =  4  then 

( Make  sure  not  a  Saturday  or  Sunday  106  ) 
end  if; 
This  code  is  used  in  section  101. 

109. 

(Procedures  and  Tasks  in  calyr  39)  += 

function  DurationTo  CalendarTime{StartD  ate  :  Time ;  dailyhours  :  WorkHours; 
hrs  :  Duration;  NRaD  :  boolean)retum  Time  is 

(Variables  local  to  DurationTo  Calendar  Time  111) 
begin 

(  Find  next  work- day  110  ) 

(  Remove  slop  112  ) 

(Find  next  work-day  110 ) 

(If  partial  day,  account  for  it  114  )(  Find  next  work-day  110  ) 

(Find  last  work- day  116) 

(Figure  out  partial  day  117) 

return  Current- Time; 
end  DurationTo  Calendar  Time; 

110. 

(  Find  next  work- day  110  )  = 

while  (-i Is WorkD ay (CurrenL Time , NRaD))  loop 
Currents  Time  <—  IncrementDay  ( CurrenL  Time); 

end  loop; 
This  code  is  used  in  sections  109(3)  and  116. 

111. 

(Variables  local  to  DurationTo CalendarTime   111)  = 

Current-Time  :  Time  <—  StartDate; 
See  also  sections  113  and  115. 
This  code  is  used  in  section  109. 
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112.      If  the  start  date  was  not  a  work  day,  and  the  the  number  of  hours  in  Start  Date  is 
greater  then  zero,  remove  it.  (Maybe  this  should  be  an  error.) 

(  Remove  slop  112  )  = 

Split  ( Current-  Time ,  Year ,  Month ,  Day ,  Seconds  ); 
if  Current-Time  ^  StartDate  then 

Seconds  <—  0.0;   Current-  Time  <—  Time. of  (  Year ,  Month  ,Day,  Seconds  ); 
end  if; 

This  code  is  used  in  section  109. 

113. 

(Variables  local  to  DurationTo  Calendar  Time   111)  -f-= 
Year  :  Year-Number ; 
Month  :  Month-Number; 
Day  :  Day-Number; 
Seconds  :  Day-Duration; 

114.      If  the  StartDate  has  seconds  l  zero  then  this  means  we  are  starting  a  new  task  in 
the  middle  of  the  day. 

( If  partial  day,  account  for  it  114 )  = 

yhrs  «—  hrs;  yrday  <—  GetD ay OfWeek (Current-Time); 
if  (dailyhours  (yrday)  —  seconds)  >  yhrs  then 

Current-Time  <—  Current-Time  +  yhrs ;  yhrs  <—  0.0; 
else 

Current-Time  <—  Current-Time  —  Seconds; 

Current- Time  <—  IncrementDay ( Current- Time); 

yhrs  <—  yhrs  —  (daily  hours  (yrday)  —  seconds); 
end  if; 
This  code  is  used  in  section  109. 

115. 

(Variables  local  to  DurationTo  Calendar  Time   111)  += 
yhrs  :  Duration; 
yrday  :  DayOfWeek; 
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116. 

(Find  last  work-day  116)  = 

yrday  <—  GetD  ay  Of  Week  (Current-Time); 
while  yhrs  >  dailyhours  (yrday )  loop 

yhrs  <—  yhrs  —  dailyhours  (yrday );    Current-Time  <—  IncrementDay (Current-Time); 
(Find  next  work- day  110  ) 
yrday  <—  GetD ay OfWeek( Current- Time)] 
if  (yrday  =  Sat)  V  (yrday  =  Sun)  then 
put  ("ERROR !  uERR0R !  uERR0R!  " );   newJine ; 

pu/("Forusomeureasonuf ailedutouf indunextuwork-dayuforudateu=u")5 
print-date  ( Current-  Time); 

if  (->IsWorkDay  (Current-Time ,  NRaD  ,  True))  then 

j>u< ( "u (N0Tuauwork-day .  )  " ); 

else 

put  ( "u  (ISuuauwork-day . )  "  ); 

end  if; 

new-line;  raise  BadDay; 

end  if; 

end  loop; 

This  code  is  used  in  section  109. 

117. 

(Figure  out  partial  day  117)  = 
if  yhrs  >  0.0  then 

Current-Time  <—  Current-Time  +  yhrs;  yhrs  <—  0.0; 
end  if; 

This  code  is  used  in  section  109. 

118. 

(  Procedures  and  Tasks  in  calyr  39  )  += 

function  CalendarTimeToDuration(StartDate  :  Time;  dailyhours  :  WorkHours; 
EndDate  :  Time;  NRaD  :  boolean )return  Duration  is 
(Variables  local  to  CalendarTimeToDuration   121 ) 
begin 

( Assert  that  input  dates  are  correct  119 ) 
(  Count  work  hours  over  total  span  of  days  122  ) 
end  CalendarTimeToDuration; 
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119.  The  StartDate  and  EndDate  must  be  valid  work  days  and  must  have  hours  less 
then  or  equal  to  the  total  number  of  hours  worked  in  a  day.  If  this  is  not  true,  raise  the 
BadDay  exception. 

( Assert  that  input  dates  are  correct  119 )  = 

if  ^Is  WorkD ay  (StartDate ,  NRaD )  V  -^Is  WorkDay  (EndDate ,  NRaD )  then 

raise  BadDay ; 
end  if; 

Split (StartD ate ,  StartYear ,  StartMonth,  StartDay ,  StartSeconds); 
dow  <r—  GetD  ay  Of  Week  (StartDate); 
if  StartS  econds  >  daily  hours  (dow)  then 

raise  BadDay ; 
end  if; 

Split(EndDate ,  EndYear ,  EndMonth ,  EndDay ,  EndSeconds  ); 
dow  <-  GetD  ay  Of  Week  (EndDate); 
if  EndSeconds  >  daily  hours  (dow)  then 

raise  BadDay ; 
end  if; 

See  also  section  120. 

This  code  is  used  in  section  118. 

120.  Also  check  that  EndDate  I  StartDate. 

( Assert  that  input  dates  are  correct  119 )  += 
if  StartDate  >  EndDate  then 

raise  BadDay ; 
end  if; 

121. 

(Variables  local  to  CalendarTimeToDuration   121 )  = 

StartYear , EndYear  :  Year-Number; 

StartMonth,  EndMonth  :  Month-Number; 

StartDay , EndDay  :  Day-Number; 

StartSeconds  ,  EndSeconds  :  Day-Duration ; 

dow  :  DayOfWeek; 
See  also  sections  124  and  127. 
This  code  is  used  in  section  118. 
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122. 

(  Count  work  hours  over  total  span  of  days  122 )  = 
if  SameDay(StartDate,EndDate)  then 

( Figure  out  duration  for  same  day  123  ) 
else 

(  Count  work  hours  for  first  day  125  ) 

(  Count  work  hours  for  intermediate  days  126  ) 

(  Count  work  hours  for  last  day  128  ) 
end  if; 
return  hrs; 

This  code  is  used  in  section  118. 

123.      Easy.  Just  Subtract. 

( Figure  out  duration  for  same  day  123  )  = 

hrs  <—  EndDate  —  StartDate; 
This  code  is  used  in  section  122. 

124. 

(Variables  local  to  CalendarTimeToDuration  121 )  += 
hrs  :  duration] 

125. 

( Count  work  hours  for  first  day  125 )  = 

dow  «—  GetDayOfWeek(StartDate);  hrs  <—  dailyhours(dow)  —  StartSeconds; 
This  code  is  used  in  section  122. 

126. 

( Count  work  hours  for  intermediate  days  126 )  = 

Current-Time  <—  Time. Of  (StartYear ,  StartMonth,  StartD ay ,0.0); 
Current-Time  <—  IncrementD  ay  (Current- Time); 
while  -^SameDay (Current-Time, EndDate)  loop 
if  Is  WorkDay  ( Current-  Time ,  NraD )  then 

dow  <—  GetDayOfWeek(Current-Time);  hrs  «—  hrs  +  dailyhours(dow); 
end  if; 

Current- Time  <—  IncrementDay ( Current- Time); 
end  loop; 
This  code  is  used  in  section  122. 

127. 

(Variables  local  to  CalendarTimeToDuration  121 )  += 
Current- Time  :  Time; 
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128. 

(  Count  work  hours  for  last  day  128  )  = 

hrs  <—  hrs  +  EndSeconds  ; 
This  code  is  used  in  section  122. 

129. 

(  Procedures  and  Tasks  in  calyr  39 )  += 

function  SameD  ay  (Timet ,  Timet  :  Time  )return  boolean  is 

( Variables  local  to  SameDay  130 ) 
begin 

Split(Timel ,  Yearl  ,  Monthl ,  Dayl ,  Seconds ); 
Split(Time2  ,  Year2  ,  MOntht , Day 2 ,  Seconds ); 
if  (  Yearl  =  Yeav2  )  A  (Monthl  =  Month.2 )  A  (Dayl  =  Day2  )  then 

return  true; 
else 

return  false; 
end  if; 
end  SameDay; 

130. 

( Variables  local  to  SameDay  130 )  = 

Yearl  ,  Year2  :  Year_Number ; 

Monthl  ,Month2  :  Month-Number; 

Dayl  ,Day2  :  Day-Number; 

Seconds  :  Day.. Duration; 
This  code  is  used  in  section  129. 

131. 

(Procedures  and  Tasks  in  calyr  39)  +  = 

function  GetD ay OfWeek (Today  :  Time )return  Day OfWeek  is 

jul  :  longAnteger; 

Month  :  Month-Number; 

Day  :  Day_Number; 

Year  :  Fear_iVuTn6er; 

Seconds  :  Day-Duration; 

fdy  :  DayO/T^eeife; 
begin 

Split  ( Today ,  Year ,  Month,  Day ,  Seconds);  jul  :=  Julian-  day  (Month,  Day ,  Fear); 
/dy  <—  DayOfWeek'val((jul  +  1)  mod  7);  return  /dy; 
end  GetD  ay  OfWeek; 
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132.  Essentially  converts  hours  to  seconds. 

( Procedures  and  Tasks  in  calyr  39 )  += 

function  ConvertHoursToDuration(hrs  :  natural)retum  Duration  is 

dur  :  duration] 
begin 

dur  <—  duration(hrs)  *  3600.0;  return  dur; 
end  ConvertHours  ToDuration ; 

133.  Essentially  converts  seconds  to  hours. 

(Procedures  and  Tasks  in  calyr  39)  += 

function  ConvertDurationToHours(dur  :  Duration)retum  natural  is 

hrs  :  natural] 
begin 

hrs  <—  natural  (float  (dur)/ 3600.0);  return  hrs; 
end  ConvertDurationTo Hours] 

134. 

(Procedures  and  Tasks  in  calyr  39)  += 

Procedure  Split(Seconds  :  Day-Duration;  Hour  :  out  Hour-Number]  Minute  :  out 
Minute-Number ; 

Second  :  out  Second- Number)    is    yrsecs  :  Day-Duration  <—  Seconds] 
begin 

Hour  *—  integer  (yrsecs  )/3600;  yrsecs  <—  yrsecs  —  Duration(Hour  *  3600); 
Minute  <—  integer  (yrsecs)/ 60]  yrsecs  <—  yrsecs  —  Duration  (Minute  *  60); 
Second  <—  integer  (yrsecs)] 
end  Split] 

135.      Prints  out  the  date. 

mm  Month  number 

dd  Day  number  in  the  month 

HH  Hour  number  (24  hour  system) 

MM  Minute  number 

SS  Second  number 

cc  Century  minus  one 

yy  Last  2  digits  of  the  year  number 

The  month,  day,  year,  and  century  may  be  omitted;  the  current  values  are  applied  as 
defaults.  For  example: 

date  10080045 

sets  the  date  to  Oct  8,  12:45  a.m.    The  current  year  is  the  default  because  no  year  is 
supplied. 
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136.  This  was  written  because  there  seemed  to  be  an  error  in  adding  86,400.0  seconds 
to  a  day  and  then  expecting  the  answer  to  come  out  right.  Errors  occured  around  April 
7,  1997  and  October  26,  1997.  I  believe  it  is  a  GNAT  bug  for  version  3.09. 

(Procedures  and  Tasks  in  calyr  39)  +  = 

function  IncrementD  ay  (YrD  ate  :  Time  )return  Time  is 

jul  :  long-integer; 

Year  :  Year- Number; 

Day  :  Day-Number; 

Month  :  Month-Number; 

Seconds  :  Day-Duration; 
begin 

Split  (  Yrdate ,  Year ,  Month ,  Day ,  Seconds  );  jul  <—  julian-day  (Month ,  Day ,  Year ); 

jul  <—  jul  +  1 ;   caldate  (jul ,  Month ,  Day ,  Year ); 

return  Time-Of  (  Year ,  Month ,  Day ,  Seconds  ); 
end  IncrementD  ay ; 
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137. 

(  Procedures  and  Tasks  in  calyr  39  )  += 
procedure  print-date  (date  :  time)  is 

(Variables  local  to  print-date   138) 

do.alternate  :  boolean  <—  true; 
begin 

Split  (date ,  Year ,  Month,  Day ,  Seconds  ); 

if  Month  <  10  then 

ptrf(»o»); 
end  if; 

put  (natural  (Month),  1);  put("/"); 
if  (fay  <  10  then 

put("0"); 
end  if; 

put  (natural  (Day),  1);  pui("/");  put(natural(  Fear), 4); 
Split(Seconds  ,  Hour,  Minute ,  Second); 
if  do-alternate  then 

jm*("+»); 

if  J7our  <  10  then 
put("0"); 

end  if; 

jm£  ( natural  ( Hour ) ,  1 ) ; 
else 

ptrf(v); 

if  Hour  <  10  then 

put("0"); 
end  if; 

pu2(na£ura/(17our),l);  pu<(": "); 
if  Minute  <  10  then 

ptrf("0"); 
end  if; 

pu<(nahtra/(MinM<e),l);  pu<(M:"); 
if  Second  <  10  then 

ptii("Of1); 
end  if; 

pw<  ( natural  ( Second ) ,  1 ) ; 
end  if; 
end  prinLdate; 


155 


CALYR  BODY  APPENDIX  E         §138 

138. 

(Variables  local  to  print-date  138)  = 

Year  :  Year-Number; 

Month  :  Month-Number; 

Day  :  Day-Number; 

Seconds  :  Day-Duration; 

Hour  :  Hour-Number; 

Minute  :  Minute-Number; 

Second  :  Second- Number; 
This  code  is  used  in  section  137. 
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139. 

(Procedures  and  Tasks  in  calyr  39)  += 

procedure  print, date (outfile  :  file.type;  date  :  time)  is 
(Variables  local  to  fprinLdate  140  ) 
do. alternate  :  boolean  <—  true; 
begin 

Split  ( date ,  Year ,  Month ,  Day ,  Seconds  ); 
if  Month  <  10  then 

put  (outfile,  "0"); 
end  if; 

put(outfile,  natural  (Month) ,  1);  put(outfile ,  "/"); 
if  day  <  10  then 

jm*(ou#iZe,M0M); 
end  if; 

put(outfile,  natural(Day),  1);  put(outfile,  "/");  put  (outfile,  natural  (  Fear), 4); 
Split(Seconds  ,  Hour ,  Minute ,  Second ); 
if  do. alternate  then 
pw<(ou#iZe,"+M); 
if  .Sour  <  10  then 
ptrf(ouil/i/e,"0"); 
end  if; 

put(outfile,  natural  (Hour),  1); 
else 

put  (outfile,  "u")i 
if  ^owr  <  10  then 
J}u*(ou*/lZe,M0,,); 
end  if; 

put  (outfile,  natural  (Hour),  1);  put(outfile ,  ":  "); 
if  Minute  <  10  then 

jm*(ouf/i/e,"0H); 
end  if; 

put  (outfile ,  natural  (Minute),!);  put(outfile,  " :  "); 
if  Second  <  10  then 

pu*(ou#iZe,"0M); 
end  if; 

put  (outfile,  natural  (Second), 1); 
end  if; 
end  print,  date, 
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140. 

( Variables  local  to  fprint-date  140  )  = 

Year  :  Year-Number; 

Month  :  Month-Number; 

Day  :  Day-Number; 

Seconds  :  Day-Duration; 

Hour  :  Hour-Number; 

Minute  :  Minute-Number; 

Second  :  Second- Number; 
This  code  is  used  in  section  139. 

141. 

( Procedures  and  Tasks  in  calyr  39 )  += 

function  get-date  (infile  :  file-type  )return  Time  is 

( Variables  local  to  fget-date   142  ) 
begin 

get  (infile,  ndum);   Month  *— ndum; 
if  debug2  then 

jptrf("Moiithu=uH);  put(Month,  1);  puUine ("."); 
end  if; 

get-immediate  (infile ,  chr);  get(infile,ndum);  Day  <—  ndum; 
if  debug2  then 

pu*("Dayu=u");  put(Day,l);  put-line  ("  ."); 
end  if; 

g eLimmediate (infile ,  chr);  g et (infile ,  nJura); 
if  ndum  <  100  then 
if  ndum  <  50  then 

Year  <—  n<ium  +  2000; 
else 

Year  <—  ndum  +  1900; 
end  if; 
else 

Fear  <—  ndum; 
end  if; 
if  debug 2  then 

^(MYearu=uM);  put  (  Year,  1);  puUine  ("."); 
end  if; 

get-immediate  (infile,  chr);  get(infile,ndum);  Hour  *—  ndum; 
return  Time-Of  (Year , Month, Day ,  ConvertHoursToDuration(Hour)); 
end  geLdate; 
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142. 

( Variables  local  to  f get-date   142  )  = 

ndum  :  natural] 

chr  :  character; 

Year  :  Year-Number; 

Month  :  Month-Number; 

Day  :  Day-Number; 

Hour  :  natural; 
This  code  is  used  in  section  141. 
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143. 

( Procedures  and  Tasks  in  calyr  39 )  += 

function  get_date(str  :  in  Ustring )return  Time  is  (Variables  local  to  geLdate   144) 
begin 

if  debug2  then 

j>u<("Paxsingustringu"M);  put(S(str));  puLline ("*."); 
end  if; 

tstr  <—  str;  get(S(tstr),  ndum,  Last);  Month  <—  ndum; 
if  debug2  then 

jm*("Monthu=uM);  put(Month,  1);  jmLftne("."); 
end  if; 

tnd  <—  mdez(farr, "/");   tstr  <—  tail  (tstr,  length  (tstr)  —  mrf); 
get(S (tstr),  ndum,  Last);  Day  <—  ndum; 
if  debug2  then 

pu<(MDayu=uM);  pui(Day,l);  pudme("."); 
end  if; 

m<£  <—  index(tstr,  "/");   fo£r  <—  tail  (tstr ,  length  (tstr)  —  ind); 
get(S(tstr),  ndum,  Last); 
if  debugB  then 

j>u<("Parsingustringu'");  /)u<(5(£s<r));  putJine("  ' .  ");  pu^'^duniLj^"); 

put(ndum,  1);  pu£_/me(" . "); 
end  if; 
if  ndum  <  100  then 

if  ndum  <  50  then 
Fear  «—  ndum  +  2000; 

else 

Fear  <—  ndum  +  1900; 

end  if; 
else 

Fear  *—  nitim; 
end  if; 
if  debug2  then 

pu<("Yearu=uM);  pu*(Fear,l);  puLline ("."); 
end  if; 

tnd  <—  tnde:c(£s£r, "+");  tsfr  <—  tail  (tstr ,  length  (tstr)  —  ind); 
get(S (tstr),  ndum, Last);  Hour  <—  ndum; 

return  Time_0f ' (  Year ,  Month ,  D ay ,  ConvertHoursToDuration(Hour)); 
end  get^date ; 
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144. 

{  Variables  local  to  get-date   144  )  = 

ndum  :  natural; 

Year  :  Year-Number; 

Month  :  Month-Number; 

Day  :  Day-Number; 

Hour  :  natural; 

Last  :  positive ; 

tstr  :  ustring; 

ind  :  natural; 
This  code  is  used  in  section  143. 
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145.      Test  Driver.      This  is  the  main  routine  that  starts  everything. 

146. 

output  to  file  main.adb 

with  Text  JO] 
use  Text  JO] 
with  Ada. Calendar] 
use  Ada. Calendar] 
with  calyr] 
use  calyr; 
with  ustrings] 
use  ustrings  ] 
with  getopt] 
use  getopt; 
procedure  main  is 

( Variables  local  to  main  150  ) 

package  yrAo  is  new  integer_io(Year_  Number); 

use  yr.io ; 

package  booLio  is  new  enumerationAo (boolean)] 

use  booLio] 
begin 

(  Get  options  147  ) 

print-holidays  (yr ,  nps ); 
end  main] 

147. 

(  Get  options  147  )  = 
(  Get  year  148  ) 
(  Get  nps  149 ) 

This  code  is  used  in  section  146. 

148. 

(  Get  year  148 )  = 

if  option_present(U("—yeax"))  then 

geLoption(U(" -year" ),param)]  get(S(param),  yr  ,Last); 
else 

yr  <-  1997; 
end  if; 
This  code  is  used  in  section  147. 
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149. 

(  Get  nps  149  )  = 

if  option.present (£/("-nps"))  then 

g  eLoption  (U ("  -nps"),  param)\  get(S(param),  nps  ,  Last); 
else 

nps  <—  false; 
end  if; 

This  code  is  used  in  section  147. 

150. 

( Variables  local  to  main  150 )  = 

yr  :  Year-number] 

param  :  Ustring; 

Last  :  positive ; 

nps  :  boolean] 
This  code  is  used  in  section  146. 
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151.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

152.  RCS  Keywords. 

$RCSfile:  calyr.aweb,v 

$  Revision:  1.1 

$Date:  1997/08/18  22:43:35 

$Author:  evansjr 

$Id:  calyr.aweb,v  1.1  1997/08/18  22:43:35  evansjr  Exp  evansjr 

$Locker:  evansjr 
$  State:  Exp 
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153.  Index.  Here  is  a  cross-reference  table  for  the  MAIN  program.  All  modules  in  which 
an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are  indexed 
only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers  in  module 
names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  correspond  to 
sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond  to  the 
section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


Ada:     9,  32,  146. 

already-leaped:     38,  42. 

Apr:     13,  59. 

Aug:     13. 

BadDay:     12,  116,  119-120. 

BadYear:     12,  95. 

booLio:     146. 

boolean:     16,  20-23,  38,  81,  101,  105,  109, 

118,  129,  137,  139,  146,  150. 
bpp:     47-48,  63. 

caldat:     57,  58-59,  61. 

caldate:     19,  88,  136. 

Calendar:     9,  146. 

CalendarTimeToDuration:     22,  118. 

Calyr:     40-41. 

calyr:     9,  42,  146. 

calyr. adb  :     9. 

calyr. ads  :     9. 

character:     142. 

chr:     141-142. 

Command-Line :     9. 

ConvertDurationToHours:     26,133. 

ConvertHoursToDuration:     25,  132, 

141,  143. 
Current-Time:     101,  105,  109-112,  114, 

116-117,  126-127. 
dailyhours:     21-22,  109,  114,  116,  118- 

119,  125-126. 

date:     28,  70-76,  137,  139. 

day:     137,  139. 

Day:     18-19,  40-41,  44,  69,  72-76,  78,  80, 

88,  91,  93,  98-99, 102-103, 112-113, 

131,  136-144. 
Day-Duration:     27,  41,  103,  113,  121, 

130-131,  134,  136,  138,  140. 


Day-Number:     18-19,  41,  88,  93,  103,  113, 

121,  130-131,  136,  138,  140,  142,  144. 
DayofWeek:     14,  80. 
DayOfWeek:     13,  24,  44,  46,  50,  52- 

53,  62-63,  70,  80,  85-87,  103,  115, 

121,  131. 
Dayl :     129-130. 
Day  2:     129-130. 
debug:     38. 
debugit:     20,  101. 
debug2:     38,  141,  143. 
Dec:     13,  77,  82. 
di:     17,  39-40,  44,  69,  72-76,  78,  80, 

83-84,  87,  101-102,  105. 
do-alternate:     137,  139. 
do-nps:     16,  81. 

dow:     101,  103,  106,  119,  121,  125-126. 
dt:     56-57,  59,  61-62. 
dur:     26,  132-133. 
duration:     124,  132. 
Duration:     15,  21-22,  25-26,  109,  115, 

118,  132-134. 
DurationTo  Calendar  Time :     21,  109. 
dw:     70-71,  74-76,  79-80. 
dy:     49,  52-53,  56,  66-67,  69-70. 
easier:     56,  59. 
edt:     56,  58. 

EndDate:     22,  118-120,  122-123,  126. 
EndDay:     119,  121. 
EndMonth:     119,  121. 
EndSeconds:     119,  121,  128. 
EndYear:     119,  121. 
enumeration-io :     146. 
Exception:     12. 
false:     20,  38,  101,  129,  149. 
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fde:     59,  61-62. 

fdm:     63,  65-66,  70,  79,  85. 

fdy:     44,  46,  62-63,  131. 

Feb:     13,  42,  52. 

file-type:     28-29,  139,  141. 

fl:     49,  70,  72-73. 

float:     89,  91,  98-99,  133. 

fourarray :     12,  49,  64. 

Fri:     13-14,  80. 

get:     141,  143,  148-149. 

get-date:     29,  141,  143. 

get-immediate:     141. 

geLoption:     148-149. 

GetDayOfWeek:     24,  101,  114,  116,  119, 

125-126,  131. 
getopt:     146. 
hfdm :     85-87. 

hmn:     40-41,  66-67,  69-70,  72-77. 
ho:     67-68,  70,  72-76. 
hoi:     43,  50-56,  66-67,  69-70,  72-76,  80. 
hoLdy:     17,  39,  67,  83,  101. 
hoLtype:     49,  50. 
holidays :     35,  87. 
Hour:     27,  134,  137-144. 
Hour-Number:     11,  27,  134,  138,  140. 
hrs:     21,  25,  109,  114,  122-126,  128, 

132-133. 
i:     83,  102- 
ICOL:     37,  54. 
IELC:     37,  66. 
IEST:     37,  56. 
IGFR:     37,  56. 
IGREG:     88,  90,  99-100. 
JJL4Z:     37. 

ii:     63,  66-70,  72-76,  83,  85,  87. 
image:     82,  85,  87. 
IMEM:     37,  53. 
IMLK:     37,  51. 
IncrementDay:     30,  HO,  114,  116,  126, 

136. 
ind:     143-144. 
index :     143. 
infile:     29,  141. 


inLio :     38. 

integer:     11-12,  17,  36-39,  44,  48,  57, 

60-61,  63-65,  68-69,  71,  84,  91-92, 

97,  99-100,  105,  134. 
Integer:     18-19,  88,  91,  93. 
integer-io:     38,  146. 
INYD:     37,  80. 
IPRS:     37,  52. 

IsWorkDay:     20,  101,  110,  116,  119,  126. 
IVET:     37,  55. 
ix:     49,  74-76,  80. 
j:     42. 

;'a:     88-91,  99-100. 
JAFD:     36,  50. 
;'a/p/ia:     89-90. 
JAN:     51. 
Jan:     13,  80,  82. 
jb :     91-92. 
jc:     91-92. 
/<?##:     36,  50. 
JCOL:     36,  50. 
j'd:     91-92. 
je:     91-92. 
J£ZC:     36,  50. 
JEST:     36,  50. 
JF.4T:     36,  50. 
JFLG:     36,  50. 
JGF#:     36,  50. 
J  HAL:     36,  50. 
JIND:     36,  50. 
;;':     63-64,  67,  69,  72-73,  78. 
JLAB:     36,  50. 
jm:     96-98. 
JM£M:     36,  50. 
JMLK:     36,  50. 
JMOT:     36,  50. 
/WTO:     36,  50. 
JPRS:     36,  50. 
J5PT:     36,  50. 
JTHX:     36,  50. 

Jul:     44-45,  93-94,  98-99,  131,  136. 
Jul:     13. 
Ju/ian:     19,  88. 
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Julian:     88-89. 

julian.day:     18,  44,  93,  131,  136. 

Julian-  day :     19. 

Jun:     13. 

JVAL:     36,  50,  74. 

JV^T:     36,  50. 

jy:     96-99. 

Zaj*:     143-144,  148-150. 

Idm:     63. 

/a>m:     34,  42,  63. 

length:     143. 

long-integer:     18,  45,  89-94,  98-100, 

131,  136. 
Long-integer:     19,  88. 
main :     146. 
main.adb  :      146. 
Mar:     13,  56,  59. 
May:     13,  53. 
Minute:     27,  134,  137-140. 
Minute-Number:     11,  27,  134,  138,  140. 
mn:     56-57,  59,  62. 
77ion :     82,  83,  85. 
MON:     50. 
Mon:     13-14,  52-53. 
Montfc:     18-19,  40-41,  44,  50,  57,  63, 

69-70,  88,  91,  93,  96,  99,  102-103, 

112-113,  131,  136-144. 
month:     13,  40,  42,  62,  82-83,  85. 
Month-Number:     18-19,  33-34,  41,  88, 

93,  103,  113,  121,  130-131,  136,  138, 

140,  142,  144. 
Monthl :     129-130. 
Montht :     129-130. 
MOnthB:     129. 
natural:     25-26,  33-35,  132-133,  137, 

139,  142,  144. 
ndm:     33,  42,  56,  59,  62-63,  69-70, 

78-80,  83. 
ndum:     141-144. 
new-line:     116. 
Nov:     13,  55,  66. 
nps:     38,  81,  87,  146,  149-150. 
NraD:     126. 


nrad:      101. 

NRaD:     20-22,  101,  109-110,   116, 

118-119. 
NumHolidays :     35. 
Oct:     13,  54-55. 
ofr:     63. 

ofrdy :     63-64,  67,  69,  72-73,  78. 
option-present:     148-149. 
outfile:     28,  139. 
param :     148-150. 
pfm:     59-60. 

pos:     42,50,52-53,62-63,70,80,83. 
positive:     144,  150. 
print-date:     28,  104,  116,  137,  139. 
print-holidays  :     16,  81,  146. 
private:     6. 
Procedure :     27,  134. 
procedure:     6. 
protected:     6. 
put:     82-83,  85,  87,  102,  116,  137,  139, 

141,  143. 
putJine:     82-83,  85,  87,  102,  104,  141, 

143. 
SameDay:     23,  122,  126,  129. 
SAT:     50. 

Sat:     13,  70,  106,  116. 
Second:     27,  134,  137-140. 
Second. Number:     11,  27,  134,  138,  140. 
seconds:     114. 
Seconds:     27,  40-41,  102-103,  112-114, 

129-131,  134,  136-140. 
Sep:     13. 
Split:     27,  40,  102,  112,  119,  129,  131, 

134,  136-137,  139. 
StartDate:     21-22,  109,  111-112,  118- 

120,  122-123,  125. 
StartDay:     119,  121,  126. 
StartMonth:     119,  121,  126. 
StartSeconds:     119,  121,  125. 
StartYear:     119,  121,  126. 
status:     17,  39-40,  69,  72-76,  78,  80, 

83-84,  87,  101-102,  105,  107-108. 
sir:     29,  143. 
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Strings:     32. 

succ:     62. 

SUN:     50. 

Sun:     13,  70,  106,  116. 

system  dependencies:     151. 

tail:     143. 

TEXTJO:     9. 

TexUO :     146. 

texLio :     10. 

threearray:     12,17,39,84,105. 

THU:     50. 

Thu:     13. 

Time:     20-24,  29-30,  101,  105,  109,  111, 

118,  127,  129,  131,  136,  141,  143. 
time:     17,  28,  39,  137,  139. 
Time-Of:     126,  136,  141,  143. 
Time-of:     83,  112. 
Timet:     23,  129. 
Timet:     23,  129. 
TMonth:     91. 
Tmonth:     91-92. 
tmp:     47-48,  78. 
Today:     24,  131. 
true:     38,  42,  106,  129,  137,  139. 
True:     116. 
tstr:     143-144. 
TUE:     50. 
Tue:     13. 
iFeor:     47-48. 
TYear:     96-97. 
Type:     15. 
w^/y:     67,  69. 
Unbounded :     32. 
tfJVST:     63-64,  67. 
foe:     32. 
ustring:     144. 
Ustring:     29,  35,  143,  150. 
Ustrings:     9,  32. 
ustring  s:     146. 
tiaZ:     40,  44,  85,  87,  131. 
verbose:     38,  82-83. 
Wed:     13. 
WeekDay:     14,  15. 


tiro:     49,  51-56,  66-67,  70. 

workday:     101,  104-106. 

Worfctfou™:     15,  21-22,  109,  118. 

Year :     18-19,  40-42,  44,  47,  51-52,  54-56, 

59,  63,  66,  88,  91,  93,  95-96,  99, 

102-103,  112-113,  131,  136-144. 
Year-number:     150. 
Year-Number:     16,  18,  41,  59,  81,  103, 

113,  121,  130-131,  136,  138,  140, 

142,  144,  146. 
Yearl :     129-130. 
Year2 :     129-130. 
yhrs:     114-117. 
yr:     16,  81,  83,  146,  148,  150. 
yrAo :     146. 
YrDate:     20,  30,  101,  105,  136. 


Yrdate  : 
yrdate : 
yrday : 
yrsecs  : 


102,  104,  136. 
17,  39-40. 
114-116. 
134. 
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Assert  that  input  dates  are  correct  119,  120  )      Used  in  section  118. 

Calculate  beginning  date  of  1st  pay  period  in  year  47 }     Used  in  section  43. 

Calculate  weekday  of  Jan  1.  44 )      Used  in  section  43. 

Check  for  bad  year  95  )       Used  in  section  93. 

Check  for  no  more  holidays  69  )      Used  in  section  67. 

Check  if  leap  year  42 )     Used  in  section  39. 

Check  if  off- Friday  moved  back  to  Thursday  73  )     Used  in  section  67. 

Compute  Easter  56  )       Used  in  section  43. 

Compute  Julian  number  98  )     Used  in  section  93. 

Compute  weekday  for  Paschal  Full  Moon  62  )     Used  in  section  59. 

Correct  for  to  Gregorian  Calendar  89 )      Used  in  section  88. 

Count  work  hours  for  first  day   125  )       Used  in  section  122. 

Count  work  hours  for  intermediate  days  126  )     Used  in  section  122. 

Count  work  hours  for  last  day  128  )     Used  in  section  122. 

Count  work  hours  over  total  span  of  days  122  )     Used  in  section  118. 

December  31  a  Friday  the  observe  Saturday,  January  1st  80  )     Used  in  section  77. 

December  processing  77 )     Used  in  section  67. 

Display  hoLdy  output   102}      Used  in  section  101. 

Exhaust  any  earlier  off- Fridays  72  )     Used  in  section  67. 

Figure  out  duration  for  same  day  123 )      Used  in  section  122. 

Figure  out  election  day  66 )     Used  in  section  63. 

Figure  out  partial  day  117  )     Used  in  section  109. 

Find  last  work-day  116  )      Used  in  section  109. 

Find  next  work-day  110  )       Used  in  sections  109(3)  and  116. 

Get  nps   149  )      Used  in  section  147. 

Get  options  147  )      Used  in  section  146. 

Get  year  148  )       Used  in  section  147. 

Holiday  with  fixed  week  day  or  fixed  date  70  )     Used  in  section  67. 

If  partial  day,  account  for  it  114 )     Used  in  section  109. 

Is  first  of  next  year  a  Friday  or  Saturday  and  this  is  an  off- Friday?  78 )     Used  in  section  77. 

Local  Procedures  59  )       Used  in  section  9. 

Look  if  NraD  off-Friday  (or  off- Thursday  if  Friday  a  holiday)  107  )      Used  in  section  101. 

Loop  over  holidays  and  Off- Fridays  67 )     Used  in  section  39. 

Loop  through  days  of  month  83  )       Used  in  section  82. 

Loop  through  months  82  )      Used  in  section  81. 

Make  sure  not  a  Saturday  or  Sunday  106  )      Used  in  sections  101,  107,  and  108(2). 

Monday/Friday  extra  day  75  )     Used  in  section  67. 

Now  finish  computation  91  )      Used  in  section  88. 

Package  boiler-plate  9 )      Used  in  section  8. 

Packages  needed  by  calyr  body  10,  32 )      Used  in  section  9. 

Parse  date  40  )      Used  in  section  39. 

Print  if  workday  104  )       Used  in  section  101. 

Print  out  first  day  of  month  85  )       Used  in  section  83. 
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Print  out  holidays,  as  necessarily  87 )     Used  in  section  83. 

Procedures  and  Tasks  in  calyr  39,  81,  88,  93,  101,  109,  118,  129,  131,  132,  133,  134,  136,  137,  139, 

141,  143  )       Used  in  section  9. 
Remove  slop   112  )      Used  in  section  109. 
Saturday  non-work  holiday  76 )      Used  in  section  67. 
See  if  federal  holiday  108  )      Used  in  section  101. 
Set  month  63  )       Used  in  section  39. 
Set  year  43  )       Used  in  section  39. 
Specification  of  procedures  visible  from  calyr  16,  17,  18,  19,  20,  21,  22,  23,  24,  25,  26,  27,  28, 

29,  30  )       Used  in  section  9. 

Specification  of  types  and  variables  visible  from  calyr  11,  12,  13,  14,  15 )     Used  in  section  9. 

Test  whether  to  change  to  Gregorian  Calendar  99 )     Used  in  section  93. 

Twiddle  some  variables  before  computing  96  )      Used  in  section  93. 

Types  and  Variables  local  to  hoLdy  41,  45,  64,  68,  71 )     Used  in  section  39. 

Types  and  variables  local  to  taster  60,  61 )      Used  in  section  59. 

Types  local  to  calyr   57  )       Used  in  section  9. 

Update  Columbus  Day  54  )       Used  in  section  43. 

Update  ML  King  Day  51  )      Used  in  section  43. 

Update  Memorial  Day  53  )     Used  in  section  43. 

Update  President's  Day  52  )      Used  in  section  43. 

Update  Veteran's  Day  55  )      Used  in  section  43. 

Variables  local  to  main   150  )       Used  in  section  146. 

Variables  local  to  CalendarTimeToDuration  121,  124,  127) 

Variables  local  to  DurationTo  Calendar  Time   111,  113,  115) 

Variables  local  to  hWorKDay   103,  105  )     Used  in  section  101. 

Variables  local  to  Julian-Day  94,  97,  100  )     Used  in  section  93. 

Variables  local  to  SameDay  130  )     Used  in  section  129. 

Variables  local  to  caldat    90,  92  )      Used  in  section  88. 

Variables  local  to  calyr    33,  34,  35,  36,  37,  38,  46,  48,  49,  50,  58,  65  ) 

Variables  local  to  fgeLdate   142  )      Used  in  section  141. 

Variables  local  to  fprint-date   140  )      Used  in  section  139. 

Variables  local  to  get-date    144  )       Used  in  section  143. 

Variables  local  to  print-date   138)      Used  in  section  137. 

Variables  local  to  print-holidays   84,  86  )     Used  in  section  81. 

Weekday  of  December  31  79  )     Used  in  section  77. 

Work,  and  normal  and  Sunday  non-work,  holiday  74  )     Used  in  section  67. 


Used  in  section  118. 
Used  in  section  109. 


Used  in  section  9. 
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§         APPENDIX  F  INTRODUCTION 

1.  Introduction.  Here  is  the  Ada  code  for  routines  used  in  calculating  probaility 
distributions.  This  code  uses  Donald  Knuth's  WEB  format  for  literate  programming.  To 
compile  and  link  the  code  in  its  present  format  you  will  need  the  Ada  version  of  the  WEB 
tool. 

It  is  available  on-line  via  the  world-wide-web  at  URL: 

http://white.nosc.mil/~evansjr/literate/ 


2.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
see  the  paper  Literate  Programming,  by  Donald  Knuth  in  The  Computer  Journal,  Vol  27, 
No.  2,  1984;  or  the  book  Weaving  a  Program:  Literate  Programming  in  WEB  by  Wayne 
Sewell,  Van  Nostrand  Reinhold,  1989.  Another  good  source  of  information  is  the  Usenet 
group  comp. programming,  literate.  It  has  information  on  new  tools  and  Frequently  Asked 
Questions  (FAQs). 

3.  The  program  consists  of  several  packages  that  are  declared  right  now;  each  of  these 
packages  and  either  the  specification  and  the  body  of  the  packages  are  sent  to  a  separate 
file.  The  main  program  itself  is  declared  later.  (Since  the  original  AWEB  package  was 
written  for  Ada  '83,  it  does  not  properly  format  new  Ada  '95  keywords  protected  and 
private  .  We  remedy  using  the  web  format  commands  below. 

format  protected  =  procedure 
format  private  =  procedure 

4.  As  a  way  of  explanation,  each  "Module"  withing  angle  brackets  (<  >)  is  expanded 
somewhere  further  down  in  the  document.  The  trailing  number  you  see  within  the  brackets 
is  where  you  can  find  this  expansion.  You  can  treat  the  modules  names  as  a  PDL  (Program 
Descriptor  Language),  a  highly  recommened  way  of  writing  and  documenting  code. 

(  Package  boiler-plate  5 ) 
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5.  Probability  Primitives. 

(  Package  boiler-plate  5  )  = 

output  to  file  probability. ads 

( Needed  packages  6 ) 
package  probability  is 

(  Specification  of  types  and  variables  visible  from  probability  7  ) 

(  Specification  of  procedures  visible  from  probability  8 ) 
end  probability ; 

output  to  file  probability. adb 

package  body  probability  is 
( Variables  local  to  probability   10  ) 
(Procedures  and  Tasks  in  probability   11 ) 
end  probability ; 
This  code  is  used  in  section  4. 

6.  Here  is  the  specification  for  generics. 

(  Needed  packages  6  )  = 

with  Ada  .Numerics  .Float-Random ; 
See  also  section  12. 
This  code  is  used  in  section  5. 

7. 

(  Specification  of  types  and  variables  visible  from  probability  7 )  = 

type  booLarray  is  array  (integer  range  <>)  of  boolean; 
This  code  is  used  in  section  5. 

8. 

(  Specification  of  procedures  visible  from  probability  8  )  = 

function  Unif orm  (Low ,  High  :  Float )retum  float; 

function  Uniform  (Low ,  High  :  Natural)retum  Natural; 

procedure  sample(M,N  :  in  natural;  yrsample  :  out  booLarray); 
This  code  is  used  in  section  5. 
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9.      Probability  functions  Body. 

10. 

( Variables  local  to  probability   10  )  = 

debug  :  boolean  <— false] 

FirstTime  :  boolean  <—  true] 
This  code  is  used  in  section  5. 

11. 

(  Procedures  and  Tasks  in  probability   11 )  = 

function  Unif orm  (Low ,  High  :  Float  )return  float  is 

use  Ada.  Numerics.  Float  Jiandom] 

PI  :  Uniformly  ^Distributed] 

G  :  Generator] 

answer  :  float ; 

tmp  :  float ; 
begin 

Reset(G)]  PI  <—  Random(G)]   tmp  <—  (High  —  Low);   answer  <—  tmp  *  (PI )  +  Low] 

return  answer; 
end  Uniform] 

See  also  sections  13  and  14. 
This  code  is  used  in  section  5. 

12. 

(  Needed  packages  6  )  += 
with  Text  JO] 
use  Text  JO] 
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13. 

( Procedures  and  Tasks  in  probability   11 )  += 

function  Uniform  (Low ,  High  :  natural )return  natural  is 
use  Ada. Numerics. Float-Random; 
PI  :  Uniformly  ^Distributed; 
G  :  Generator; 
tmp ,  tmp  2  :  float  ; 
answer  :  natural] 

package  fit  Jo  is  new  float  Jo  (float)] 
use  fit  Jo  ] 
begin 

if  Low  —  High  then 

answer  <—  Xotu; 
else 

if  First  Time  then 

flese*  ((7,68069);  FirstTime  *-  false] 
else 

Reset(G); 
end  if; 

PI  <—  Random(G)]  tmp  <—  float  (High  —  Zoiu  +  1);  £mp2  <—  (<mp  *  PI)  —  0.5; 
if  (debug)  then 

2>uJ("Randomugeneratedu" );  put(Pl)]  putJine("  .u")] 
pu<(M(high-low+l)utmpu=u");  put(tmp)]  putJine("  ,u")] 
pwi("(tmp*pl)utmp2u=u");  put(tmp2);  putJine("  .u")> 
end  if; 

answer  <—  natural(tmp2)  +  Zotu; 
end  if; 

return  ansiwer; 
end  Uniform] 
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14.      Based  on  a  routine  from  the  September,  1987  Communications  of  the  ACM. 

( Procedures  and  Tasks  in  probability   11 )  += 

procedure  sample(M,N  :  in  natural;  yrsample  :  out  booLarray)  is 
t  :  natural; 
k  :  natural; 
begin 

for  j  G  1  . .  N  loop 

yr sample  (j)  <—  false ; 
end  loop; 
k<-N-M  +  l] 
for  j  6  k  . .  N  loop 
t  <r—  uniform(l,j); 
if  yrsample(t)  then 

yrsample(j)  «—  irue; 
else 

yrsample(t)  <—  true; 
end  if; 
end  loop; 
end  sample ; 
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15.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

16.  RCS  Keywords. 

$RCSnle:  probability. aweb,v 

$  Revision:  1.1 

$Date:  1997/08/03  21:35:14 

$Author:  evansjr 

$Id:  probability. aweb,v  1.1  1997/08/03  21:35:14  evansjr  Exp  evansjr 

$Locker:  evansjr 
$State:  Exp 
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INDEX 


17.  Index.  Here  is  a  cross-reference  table  for  the  MAIN  program.  All  modules  in  which 
an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are  indexed 
only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers  in  module 
names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  correspond  to 
sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond  to  the 
section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


Ada:     6,  11,  13. 
answer:     11,  13. 
booLarray:     7,  8,  14. 
boolean:     7,  10. 
debug:     10,  13. 
false:     10,  13-14. 
FirstTime:     10,  13. 
float:     8,  11,  13. 
Float:     8,  11. 
float-io:     13. 

Float-Random:     6,  11,  13. 
flUo :     13. 
Generator:     11,  13. 
High:     8,  11,  13. 
integer:     7. 
j:     14. 

Low:     8,  11,  13. 
natural:     8,  13-14. 
Natural:     8. 
Numerics:     6,  11,  13. 
private:     3. 
probability:     5. 
probability. adb  :     5. 
probability. ads  :     5. 
procedure:     3. 
protected:     3. 
put:     13. 
putJine:     13. 
PI:     11,  13. 
Random:     11,  13. 
Reset:     11,  13. 
sample:     8,  14. 
system  dependencies:     15. 
Text  JO:     12. 
tmp:     11,  13. 


tmp2:     13. 
true:     10,  14. 
uniform:     14. 
Uniform:     8,  H,  13. 
Uniformly ^Distributed :     11,  13. 
yrsample:     8,  14. 
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(  Needed  packages   6,  12  )       Used  in  section  5. 

(  Package  boiler-plate  5  )      Used  in  section  4. 

(  Procedures  and  Tasks  in  probability   11,  13,  14  )     Used  in  section  5. 

(  Specification  of  procedures  visible  from  probability  8  )     Used  in  section  5. 

(  Specification  of  types  and  variables  visible  from  probability  7  )     Used  in  section  5. 

( Variables  local  to  probability   10  )      Used  in  section  5. 
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Section  Page 

Introduction  1  183 

Getopt  Specification    7  184 

GetOpt  Body  10  185 

System- dependent  changes    21  189 

Index   23  190 
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§         APPENDIX  G  INTRODUCTION 

1.  Introduction.  This  package  provides  some  primitive  command-line  processing  typ- 
ical of  Unix  commands. 

2.  This  code  is  written  using  Donald  Knuth's  WEB  paradigm  for  literate  programming. 
To  compile  and  link  the  code  in  its  present  format  you  will  need  the  Ada  version  of  the 
WEB  tool. 

It  is  available  on-line  via  the  world-wide-web  at  URL: 

http://white.nosc.mil/~evansjr/Hterate/ 


3.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
see  the  paper  Literate  Programming,  by  Donald  Knuth  in  The  Computer  Journal,  Vol  27, 
No.  2,  1984;  or  the  book  Weaving  a  Program:  Literate  Programming  in  WEB  by  Wayne 
Sewell,  Van  Nostrand  Reinhold,  1989.  Another  good  source  of  information  is  the  Usenet 
group  comp. programming. literate.  It  has  information  on  new  tools  and  Frequently  Asked 
Questions  (FAQs). 

4.  The  program  consists  of  several  packages  that  are  declared  right  now;  each  of  these 
packages  and  either  the  specification  and  the  body  of  the  packages  are  sent  to  a  separate 
file.  The  main  program  itself  is  declared  later.  (Since  the  original  AWEB  package  was 
written  for  Ada  '83,  it  does  not  properly  format  new  Ada  '95  keywords  protected  and 
private  .  We  remedy  using  the  web  format  commands  below. 

format  protected  =  procedure 
format  private  =  procedure 

5.  As  a  way  of  explanation,  each  "Module"  withing  angle  brackets  (<  >)  is  expanded 
somewhere  further  down  in  the  document.  Consider  it  a  high-level  PDL  (Program  De- 
scriptor Language).  The  trailing  number  you  see  within  the  brackets  is  where  you  can  find 
this  expansion.  It  is  top-down  in  appearance,  and  in  actual  fact. 

6.  All  the  modules  follow  the  same,  top-down  format.  I  will  group  all  the  boiler-plate  into 
one  module,  for  the  compiler,  but  you  will  see  it  with  the  packages,  as  they  are  described. 

( Package  boiler-plate  7 ) 
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7.      Getopt  Specification. 

(  Package  boiler-plate  7 )  = 
output  to  file  getopt. ads 

with  Ustrings] 

use  Ustrings ; 

with  TEXTJO; 

use  TEXTJO; 

with  Ada  .Command-Line; 

use  Ada  .Command-Line] 

package  getopt  is 

(  Specification  of  types  and  variables  visible  from  getopt  8  ) 

(  Specification  of  procedures  visible  from  getopt  9 ) 
end  getopt] 

output  to  file  getopt. adb 

(  Packages  needed  by  getopt  body  11 ) 
package  body  getopt  is 

( Variables  local  to  getopt  12  ) 

(  Procedures  and  Tasks  in  getopt  13 ) 
end  getopt] 
This  code  is  used  in  section  6. 

8. 

(  Specification  of  types  and  variables  visible  from  getopt  8  )  = 
This  code  is  used  in  section  7. 

9. 

(  Specification  of  procedures  visible  from  getopt  9  )  = 

function  option-present  (option  :  in  Ustring  )return  boolean] 

function  name-present(Num  :  natural)return  boolean; 

procedure  geLoption (option  :  in  Ustring ; param  :  out  Ustring); 

procedure  geLname(name  :  out  Ustring]  Num  :  in  natural)] 
This  code  is  used  in  section  7. 
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10.      GetOpt  Body. 

11. 

( Packages  needed  by  getopt  body  11 )  = 

with  Ada. Strings. Unbounded]   Use  Ada. Strings. Unbounded]  with  Ustrings] 

use  Ustrings ; 
This  code  is  used  in  section  7. 

12. 

( Variables  local  to  getopt   12 )  = 

debug  :  boolean  <—  false] 
This  code  is  used  in  section  7. 

13. 

( Procedures  and  Tasks  in  getopt  13 )  = 

package  natio  is  new  integerAo (natural)] 
See  also  sections  14,  15,  16,  and  19. 
This  code  is  used  in  section  7. 

14. 

(  Procedures  and  Tasks  in  getopt  13  )  += 

function  option-present  (option  :  in  Ustring)return  boolean  is 
knt  :  natural] 
ispresent  :  boolean; 
begin 

knt  <—  Argument-Count]  ispresent  <—  false] 
for  i  €  1  . .  knt  loop 

if  S(option)  =  Argument(i)  then 

ispresent  <—  true]  exit; 
end  if; 
end  loop; 
return  ispresent] 
end  option-present] 
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15. 

(  Procedures  and  Tasks  in  getopt  13 )  += 

procedure  get-option  (option  :  in  Ustring ;  param  :  out  Ustring)  is 

knt  :  natural] 
begin 

knt  <—  Argument-Count\ 
for  i  £  1  . .  knt  loop 

if  S(option)  =  j4r<7wme7i£(i)  then 

param  <—  U  (Argument(i  +  1)); 
end  if; 
end  loop; 
end  get-option; 

16. 

(  Procedures  and  Tasks  in  getopt  13  )  += 

function  name-present(Num  :  natural)retum  boolean  is 
fcn£ ,  ic  :  natural ; 
i  :  natural  <—  1; 
/fen£  :  natural  *—  0; 
ispresent  :  boolean; 
begin 

ispresent  <— false; 
if  debug  then 

putAine  ("name_present>"); 
end  if; 

Aint  <—  Argument-Count; 
while  (i  <  fcni)  loop 

( If  found  option,  skip  it  and  its  parameter  17 ) 
( if  not  option,  must  be  name,  return  true  if  right  number  18 ) 
end  loop; 
if  debug  then 

put (" Argument u");   natio .put(Num ,  1); 
if  ispresent  then 

puLline  (Muisupresent . "); 
else 

puLline  ("uisuNuTupresent .  " ); 
end  if; 
end  if; 

return  ispresent; 
end  name-present; 
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17. 

( If  found  option,  skip  it  and  its  parameter  17 )  = 
ic  *—  Index  (U  (Argument  (i)),  "-"); 
if  ic  >  0  then 

i  <—  i  +  2; 
end  if; 
if  debug  then 

puL/me("Skippinguf irstuoption. "); 
end  if; 
This  code  is  used  in  sections  16  and  19. 

18. 

( if  not  option,  must  be  name,  return  true  if  right  number  18 )  = 
if  ic  =  0  then 
fknt  <—  fknt  +  1; 
if  fknt  —  num  then 
if  debug  then 

puLline  ("Founduyouruinputijf  ileuname! "); 
end  if; 

ispresent  <—  true;  exit; 
end  if; 
i  «—  i  +  1; 
end  if; 
This  code  is  used  in  section  16. 

19. 

(  Procedures  and  Tasks  in  getopt  13  )  += 

procedure  geLname(name  :  out  Ustring\Num  :  natural)  is 
knt ,  ic  :  natural ; 
i  :  natural  <—  1; 
fknt  :  natural  <—  0; 
begin 

if  debug  then 

puL/zne("get_name>M ); 
end  if; 

knt  *—  Arguments  Count] 
while  (i  <  knt)  loop 

( If  found  option,  skip  it  and  its  parameter  17 ) 
( if  not  option,  must  be  name,  return  if  right  number  20 ) 
end  loop; 
end  geLname] 
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20. 

( if  not  option,  must  be  name,  return  if  right  number  20 )  = 
if  ic  =  0  then 
fknt  <—  fknt  +  1; 
if  fknt  =  num  then 
if  debug  then 

puL/ine("Founduyouruinputuf  ileuname! "); 
end  if; 

name  <—  U (Argument (i));  exit; 
end  if; 
i  <—  i  +  1; 
end  if; 

This  code  is  used  in  section  19. 
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21.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

22.  RCS  Keywords. 

$RCSfile:  getopt.aweb,v 

$  Revision:  1.1 

$Date:  1997/09/05  00:28:36 

$  Author:  evansjr 

$Id:  getopt.aweb,v  1.1  1997/09/05  00:28:36  evansjr  Exp  evansjr 

$Locker:  evansjr 
$State:  Exp 
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23.  Index.  Here  is  a  cross-reference  table  for  the  MAIN  program.  All  modules  in  which 
an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are  indexed 
only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers  in  module 
names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  correspond  to 
sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond  to  the 
section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 

Ada:     7,  11.  TEXT.IO:     7. 

Argument:     14-15,  17,  20.  true:     14,  18. 

Argument-Count:     14-16,  19.  Unbounded:     11. 

boolean:     9,  12,  14,  16.  Use:     11. 

Command-Line:     7.  Ustring:     9,  14-15,  19. 

debug:     12,  16-20.  Ustrings:     7,  11. 

false:     12,  14,  16. 

fknt:     16,  18-20. 

get-name:     9,  19. 

get-option:     9,  15. 

getopt:      7. 

getopt.adb  :      7. 

getopt  .ads  :     7. 

i:     14,  15. 

ic:     16-20. 

Index:     17. 

integer-io :     13. 

ispresent:     14,  16,  18. 

knt:     14-16,  19. 

name:     9,  19-20. 

name-present:     9,  16. 

natio:     13,  16. 

natural:     9,  13-16,  19. 

num:     18,  20. 

Num:     9,  16,  19. 

option:     9,  14-15. 

option-present:     9,  14. 

param:     9,  15. 

private:     4. 

procedure:     4. 

protected:     4. 

put:     16. 

put-line:     16-20. 

Strings:     11. 

system  dependencies:     21. 
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If  found  option,  skip  it  and  its  parameter  17 )      Used  in  sections  16  and  19. 

Package  boiler-plate  7 )      Used  in  section  6. 

Packages  needed  by  getopt  body  11 )     Used  in  section  7. 

Procedures  and  Tasks  in  getopt  13,  14,  15,  16,  19  )     Used  in  section  7. 

Specification  of  procedures  visible  from  getopt  9  )     Used  in  section  7. 

Specification  of  types  and  variables  visible  from  getopt  8 )     Used  in  section  7. 

Variables  local  to  getopt   12 )     Used  in  section  7. 

if  not  option,  must  be  name,  return  if  right  number  20  )      Used  in  section  19. 

if  not  option,  must  be  name,  return  true  if  right  number  18 )     Used  in  section  16. 
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1.      Introduction.      Here  is  some  code  to  test  capabilities.    It  is  written  using  Donald 
Knuth's  WEB  format  for  literate  programming.  To  compile  and  link  the  code  in  its  present 
format  you  will  need  the  Ada  version  of  the  WEB  tool. 
It  is  available  on-line  via  the  world-wide-web  at  URL: 

http://white.nosc.mil/~evansjr/literate/ 


2.  WEB  is  a  literate  programming  paradigm  for  C,  Pascal  or  Ada,  and  other  languages. 
This  style  of  programming  is  called  "Literate  Programming."  For  Further  information 
get  the  book  Literate  Programming,  by  Donald  Knuth,  published  by  the  Center  for  the 
Study  of  Language  and  Information,  Stanford  University,  1992.  Another  good  source  of 
information  is  the  Usenet  group  comp. programming. literate.  It  has  information  on  tools 
and  answers  to  Frequently  Asked  Questions  (FAQs). 

3.  Who  should  use  the  WEB  paradigm  for  programming?  Well,  not  everybody.  Here  are 
a  few  paragraphs  from  Donald  Knuth's  book  that  explains  it  best. 

4.  Retrospect  and  Prospects.  Enthusiastic  reports  about  new  computer  languages, 
by  the  authors  of  those  languages,  are  commonplace.  Hence  I'm  well  aware  of  the 
fact  that  my  own  experiences  cannot  be  extrapolated  too  far.  I  also  realize  that, 
whenever  I  have  encountered  a  problem  with  WEB,  I've  simply  changed  the  system; 
other  users  of  WEB  cannot  operate  under  the  same  ground  rules. 

5.  However,  I  believe  that  I  have  stumbled  on  a  way  of  programming  that  produces 
better  programs  that  are  more  portable  and  more  easily  understood  and  maintained 
than  ever  before;  furthermore,  the  system  seems  to  work  with  large  programs  as 
well  as  with  small  ones.  I'm  pleased  that  my  work  on  typography,  which  began  as 
an  application  of  computers  to  another  field,  has  come  full  circle  and  become  an 
application  of  typography  to  the  heart  of  computer  science;  I  like  to  think  of  WEB  as 
a  neat  "spinoff"  of  my  research  on  TpjX.  However,  all  of  my  experiences  with  this 
system  have  been  highly  colored  by  my  own  tastes,  and  only  time  will  tell  if  a  large 
number  of  other  people  will  find  WEB  to  be  equally  attractive  and  useful. 
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6.  I  made  a  conscious  decision  not  to  design  a  language  that  would  be  suitable  for 
everybody.  My  goal  was  to  provide  a  tool  for  system  programmers,  not  for  high 
school  students  or  for  hobbyists.  I  don't  have  anything  against  high  school  students 
and  hobbyists,  but  I  don't  believe  every  computer  language  should  attempt  to  offer 
all  things  to  all  people.  A  user  of  WEB  needs  to  be  good  enough  at  computer  science 
that  he  or  she  is  comfortable  dealing  with  several  languates  simultaneously.  Since 
WEB  combines  T^X  and  Pascal  with  a  few  rules  of  its  own,  WEB  programs  can  contain 
WEB  syntax  errors.  T^X  syntax  errors,  Pascal  syntax  errors,  and  algorithmic  errors; 
in  practice,  all  four  types  of  errors  occur,  and  a  bit  of  sophistication  is  needed  to 
sort  out  which  is  which.  Computer  specialists  tend  to  be  better  at  such  things  than 
other  people.  I  have  found  that  WEB  programs  can  be  debugged  rapidly  in  spite  of 
the  profusion  of  languages,  but  I'm  sure  that  many  other  intelligent  people  will  find 
such  a  task  difficult. 

7.  In  other  words,  WEB  seems  to  be  specifically  for  the  peculiar  breed  of  people  who 
are  called  computer  scientists.  And  I'm  pretty  sure  that  there  are  also  a  lot  of 
computer  scientists  who  will  not  enjoy  using  WEB;  some  of  us  are  glad  that  tradi- 
tional programming  languages  have  comparatively  primitive  capabilities  for  inserted 
comments,  because  such  difficulties  provide  a  good  excuse  for  not  documenting  pro- 
grams well.  Thus,  WEB  may  be  only  for  the  subset  of  computer  scientists  who  like 
to  write  and  to  explain  what  they  are  doing.  My  hope  is  that  the  ability  to  make 
explanations  more  natural  will  cause  more  programmers  to  discover  the  joys  of  lit- 
erate programming,  because  I  believe  it's  quite  a  pleasure  to  combine  verbal  and 
mathematical  skills;  but  perhaps  I'm  hoping  for  too  much.  The  fact  that  a  least 
one  paper  has  been  written  that  is  a  syntactically  correct  ALGOL  68  program  en- 
courages me  to  perservere  in  my  hopes  for  the  future.  Perhaps  we  will  even  one  day 
find  Pulitzer  prizes  awarded  to  computer  programs. 

8.  Donald  Knuth  goes  on  to  write  about  his  hopes  for  the  future  of  WEB  programming. 
In  an  interview  with  Donald  Knuth  by  Amazon  Books  on  the  release  of  a  new  edition  of 
Volume  1  of  The  Art  of  Computer  Programming  (July  1,  1997)  he  was  asked: 

Amazon.com:  What  do  you  see  as  the  most 
interesting  advance  in  programming  since  you 
published  the  first  edition? 

Donald  Knuth:  It's  what  I  call  literate 
programming,  a  technique  for  writing,  documenting, 
and  maintaining  programs  using  a  high-level 
language  combined  with  a  written  language  like 
English.  This  is  discussed  in  my  book  Literate 
Programming. 
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9.  In  the  same  book,  Literate  Programming,  there  is  a  chapter  called  How  to  read  a  WEB. 
But  it  is  actually  quite  straightforward. 

10.  Very  briefly,  each  "Module"  within  angle  brackets  (<  >)  is  expanded  somewhere 
further  down  in  the  document.  The  trailing  number  you  see  within  the  brackets  is  where 
you  can  find  this  expansion.  This  provides  a  type  of  PDL  (program  descriptor  language) 
for  your  program  and  greatly  aids  modularity  and  readability.  It  is  also  a  highly  effective 
method  of  top-down  programming.  The  first  module  here  is  expanded  further  down,  and 
contains  most  of  the  structure  in  standard  Ada  packages. 

( Package  boiler-plate  11 ) 
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11.      Capabilities  specification. 

(  Package  boiler-plate  11 )  = 

output  to  file  capability  .ads 

with  TEXTJO; 
use  TEXTJO; 
with  test-io-pkg ; 
use  test-io-pkg ; 
with  genericseLpkg; 
with  generic-map-pkg; 
with  ustrings; 
use  ustrings; 
package  capability  is 

(  Specification  of  types  and  variables  visible  from  capability   12  ) 

(  Specification  of  procedures  visible  from  capability  14  ) 
private 

(  Specification  of  private  types  in  capability   21 ) 
end  capability ; 

output  to  file  capability. adb 

with  unchecked^  deallocation; 

with  generic-map-pkg; 

with  Ada. Strings. Unbounded;   Use  Ada. Strings. Unbounded;  with  Ustrings; 

use  ustrings; 

with  Ada. Strings; 

use  Ada. strings; 

with  Ada. Characters. handling; 

use  Ada. Characters  .handling; 

package  body  capability  is 

( Variables  and  types  local  to  capability  23  ) 

( Procedures  and  Tasks  in  capability  28  ) 
begin 

( Initialize  capabilities  42  ) 
end  capability ; 
This  code  is  used  in  section  10. 

12. 

(  Specification  of  types  and  variables  visible  from  capability   12  )  = 

type  deveLnum  is  private; 

type  A  String  is  access  String; 

type  ExpertiseLevel  is  (low ,  medium ,  high); 

package  cap-map  is  new  generic-map_pkg(key  =>  A  string ,  result  =>  ExpertiseLevel); 
See  also  section  13. 
This  code  is  used  in  section  11. 
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13. 

(  Specification  of  types  and  variables  visible  from  capability   12 )  += 
badid  :  exception; 
parsecapabilityerror  :  exception; 

14. 

(  Specification  of  procedures  visible  from  capability   14  )  = 

procedure  create- developer  (developer  :  in  String;yrid  :  out  natural)] 
See  also  sections  15,  16,  17,  18,  19,  and  20. 
This  code  is  used  in  section  11. 

15. 

(  Specification  of  procedures  visible  from  capability  14  )  += 

procedure  add- capability  (id  :  in  natural ;  yrcap  :  String]  exp  :  ExpertiseLevel)] 
procedure  add.  capability  (yrid  :  in  deveLnum]  yrcap  :  cap -map  .map); 
procedure  add- capability  (yrtask  :  in  out  cap-map  .map ;  yrcap  :  String; 
exp  :  ExpertiseLevel); 

16. 

(  Specification  of  procedures  visible  from  capability   14  )  += 

procedure  copy- capability  (yrid  :  in  natural ;  yrcap  :  out  cap -map  .map)] 

17. 

(  Specification  of  procedures  visible  from  capability   14  )  += 
procedure  print- capabilities  (id  :  natural)] 
procedure  print- capabilities  (yrtask  :  cap.map .map)] 
procedure  print-capabilities  (fd  :  file-type ;  yrtask  :  cap-map  .map)] 
procedure  print-developers; 
function  get-developer-name  (id  :  rca£ura/)return  ustring; 

18. 

(  Specification  of  procedures  visible  from  capability  14  )  += 

function  is-  qualified  (yrtask  :  cap -map  .map;  id  :  natural  )return  boolean; 

19. 

(  Specification  of  procedures  visible  from  capability   14  )  += 

procedure  get-capability(str  :  in  String]  yrcap  :  out  cap. map  .map); 
procedure  get-  capability  (fd  :  file-type ;  yrcap  :  out  cap -map  .map)] 
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20. 

(Specification  of  procedures  visible  from  capability  14)  +  = 
procedure  get-developers [infile  :  string)] 
function  geLnum- developers  return  natural] 

21. 

(  Specification  of  private  types  in  capability  21 )  = 

package  capset  is  new  genericset-pkg(Astring)', 

type  capability  is  new  capset.set; 

max-dev elopers  :  constant  natural  <—  20; 

type  deveLnum  is  new  natural  range  1  . .  max_developers ; 
This  code  is  used  in  section  11. 
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22.      Capability  Body. 

23. 

( Variables  and  types  local  to  capability  23 )  = 
debug  :  boolean  <—  false; 
debug2  :  boolean  *— false; 
g string  :  V string ; 

See  also  sections  24,  25,  26,  and  27. 
This  code  is  used  in  section  11. 

24.  Maintain  a  global  set  of  capabilities; 

( Variables  and  types  local  to  capability  23 )  += 
globalcaps  :  capset.set; 
totaLdev elopers  :  natural  <—  0; 

25.  Creating  new  step. 

( Variables  and  types  local  to  capability  23  )  -f = 
function  "+"(str  :  string )return  Astring  is 
begin 

return  new  string' (str); 
end  "+"; 

26. 

( Variables  and  types  local  to  capability  23 )  += 
MAXCAPS  :  constant  natural  <—  30; 
type  cap-num  is  new  natural  range  1  . .  MAXCAPS; 
type  cap-array  is  array  (cap_nwm)  of  id^irm^f; 
capabilities  :  cap-array  *—  (+"Ada",+"Databasen,  +"XWindows",  +"Graphics", 

+ "Unix", others   =>  null); 
mycaps  :  caps et. set; 
totaLcaps  :  cap_num  <—  5; 

27. 

( Variables  and  types  local  to  capability  23 )  += 
type  cap^rec  is 
record 

inuse  :  boolean  <—  false; 
name  :  j4j<rm<7; 
cmap  :  cap^map .map; 
end  record; 
type  developer- array  is  array  (deveLnum)  of  cap.rec; 
developers  :  dev eloper- array ; 
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28. 

( Procedures  and  Tasks  in  capability  28 )  = 

procedure  create- developer  (developer  :  in  String;yrid  :  out  natural)  is 
knt  :  deveLnum; 
tmpcap  :  cap-map  .map ; 
begin 

( Fetch  an  unused  developer  29 ) 
(  Assign  capabilities  to  him  30  ) 
( Create  capability  out  of  his  name  31 ) 
end  create-  dev eloper ; 
See  also  sections  33,  34,  35,  41,  44,  45,  46,  47,  48,  49,  50,  52,  62,  63,  and  69. 
This  code  is  used  in  section  11. 

29. 

( Fetch  an  unused  developer  29  )  = 

knt  <—  1; 

"while  developers  (knt). inuse  loop 
knt  <—  knt  +  1; 

end  loop; 

developers  (knt). inuse  <—  true;  total-developers  <—  totaLdevelopers  +1; 

yrid  <—  natural  (knt); 
This  code  is  used  in  section  28. 

30. 

( Assign  capabilities  to  him  30 )  = 

<D{for  i  E  1  . .  totaLcaps  loop 

cap-map  .bind (capabilities  (i),  low ,  developers  (knt). cmap); 

end  loop; 

<D} 
This  code  is  used  in  section  28. 

31. 

( Create  capability  out  of  his  name  31 )  = 

totaLcaps  <—  totaLcaps  +  1;   capabilities  (totaLcaps)  < \-developer; 

cap-map  .bind (capabilities  (totaLcaps ),  high ,  developers  (knt). cmap); 
capset  .add (capabilities  (totaLcaps  ),  globalcaps  ); 
developers  (knt). name  <—  capabilities  (totaLcaps); 
( Add  this  capability  to  all  the  other  developers  32 ) 
if  debug  then 

print-developers ; 
end  if; 

This  code  is  used  in  section  28. 
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32. 

( Add  this  capability  to  all  the  other  developers  32 )  = 
<fi-[for  i  G  deveLnum  loop 

if  (developers (i).inuse)  A  (i  =fi  id)  then 
if  debug2  then 

jpu<(MAddingucapabilityu");  put  (developer);  put  ("utoudeveloperu"); 
put  ( developers  (i). name  .all);  puLline("  .  u")> 
end  if; 

cap-map  .bind  (capabilities  (totaLcaps  ),  low ,  developers  (i).cmap); 
end  if; 
end  loop; 
€} 
This  code  is  used  in  section  31. 

33. 

(  Procedures  and  Tasks  in  capability  28  )  += 

procedure  add- capability  (yrtask  :  in  out  cap^map .map ;  yrcap  :  String; 
exp  :  ExpertiseLevel)  is 
acap  :  Astring; 
is-member  :  boolean; 
knt  :  cap_num; 
begin 

( First  convert  to  upper-case  37  )  (  See  if  already  in  capabilities  array  38  ) 
if  —>is-member  then 

totaLcaps  <—  totaLcaps  +  1;   capabilities  (totaLcaps)  <—  acap; 
cap-set. add  (capabilities  (totaLcaps),  globalcaps);  knt  <—  totaLcaps; 
end  if  ; 

cap_map .bind (capabilities (knt),  exp , yrtask ); 
end  add.  capability ; 
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34. 

(  Procedures  and  Tasks  in  capability  28  )  += 

procedure  ad(L capability  (yrid  :  in  deveLnum;  yrcap  :  cap.map  .map)  is 
expl  :  Expertise  Lev  el ; 
id  :  natural] 
begin 

id  <—  natural  (yrid); 

for  i  E  1  . .  totaLcaps  loop 

if  cap. map .  member  (capabilities  (i),  yrcap)  then 
expl  <—  cap.map. fetch  (yrcap  capabilities  (i)); 
addL capability  (id ,  capabilities  (i).all,  expl ); 
end  if; 
end  loop; 
end  add.  capability ; 

35. 

(  Procedures  and  Tasks  in  capability  28  )  += 

procedure  adcL capability  (id  :  in  natural ;  yrcap  :  String]  exp  :  ExpertiseLevel)  is 
a  cap  :  A.s£rina; 
is.member  :  boolean; 
knt  :  cap.num; 
yrid  :  deveLnum; 

package  enum.io  is  new  enumeration _io (ExpertiseLevel); 
begin 

yrid  <—  deveLnum  (id); 

if  — 'developers (yrid). inuse  then 

raise  badid; 
end  if; 

(  First  convert  to  upper-case  37 )(  See  if  already  in  capabilities  array  38  ) 
if  -lis-member  then 

totaLcaps  <—  totaLcaps  +  1;  capabilities  (totaLcaps)  <—  acap; 
cap. set  .add  (capabilities  (totaLcaps),  globalcaps);   (Add  to  all  developers  40  ) 
else 

(  Update  capabilities  of  this  developer  39 ) 
end  if; 
end  add.  capability ; 
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36. 

(  Convert  to  upper-case  36  )  = 
declare 

tstr  :  string  <—  yrcap ; 
name  :  ustring; 
begin 

name  <—  get-developer-name  [natural  (yrid)); 
if  tstr  ^  S(name)  then 

for  j  €  1  . .  yrcap' length  loop 
tstr(j)  *—  to-upper(tstr(j))\ 
end  loop; 
end  if; 

acap  < \-tstr; 

end; 

37. 

( First  convert  to  upper-case  37 )  = 
declare 

tstr  :  string  *—  yrcap ; 
begin 

for  j  6  1  . .  yrcap' length  loop 
tstr(j)  <—  to..upper(tstr(j))] 
end  loop; 

acap  < \-tstr\ 

end; 
This  code  is  used  in  sections  33  and  35. 

38. 

( See  if  already  in  capabilities  array  38 )  = 
is-member  <—  false; 
for  i  E  1  •  •  totaLcaps  loop 

if  (capa6s7*ttej(i).all  =  acap  .all)  then 

acap  <—  capabilities  (i);   fcn<  <—  i;  is^member  <—  frae;  exit; 
end  if; 
end  loop; 
This  code  is  used  in  sections  33  and  35. 
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39. 

(  Update  capabilities  of  this  developer  39  )  = 
if  debug  then 

pu<("Updatingucapabilitiesuofudeveloper:uM); 

put  (S(geLdeveloper_name  (natural  (yrid))))]  put("uu");  put  (capabilities  (knt).a\\); 
put(" u=>u")]   enumAo .put(exp);  newAine] 
end  if; 

cap-map  .bind  (capabilities  (knt),  exp,  developers  (yrid).cmap); 
This  code  is  used  in  section  35. 

40. 

(  Add  to  all  developers  40  )  = 
for  i  E  deveLnum  loop 
if  (i  ^  yrid )  then 

if  (developers (i).inuse)  then 

cap^map  .bind  (capabilities  (totaLcaps  ),  low,  developers  (i).cmap ); 
end  if; 
else 

cap^map .bind (capabilities  (totaLcaps ),  exp ,  developers  (i).cmap ); 
end  if; 
end  loop; 
This  code  is  used  in  section  35. 

41.      Copy  everything  but  developer's  name. 

(  Procedures  and  Tasks  in  capability  28 )  += 

procedure  copy_  capability  (yrid  :  in  natural ;  yrcap  :  out  cap_map  .map)  is 
expl  :  ExpertiseLevel; 
yr  :  deveLnum; 
namel ,  name2  :  ustring; 
begin 

yr  <—  deveLnum(yrid); 
for  i  £  1  . .  totaLcaps  loop 

if  cap-map  .member  (capabilities  (i),  developers  (yr).cmap)  then 

namel  «—  U (capabilities  (z).all);   name2  <—  geLdev eloper ^name(yrid)', 
if  namel  ^  name2  then 

expl  <—  cap-map.fetch(developers(yr).cmap ,  capabilities (i)); 
ada\. capability  (yrcap ,  capabilities  (t).all,  expl ); 
end  if; 
end  if; 
end  loop; 
end  copy_  capability ; 
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42. 

( Initialize  capabilities  42 )  = 
cap-set  .empty  (globalcaps ); 
for  i  G  1  •  •  totaLcaps  loop 
(  Convert  to  uppercase  43  ) 

capabilities  (i)  < \-S(gstring  );   cap-set  .add (capabilities  (i),  globalcaps  ); 

end  loop; 
This  code  is  used  in  section  11. 

43. 

(  Convert  to  uppercase  43  )  = 
declare 

tstr  :  String  <—  capabilities  (i').all; 
chr  :  Character; 
begin 

for  j  £  1  . .  tstr' length  loop 

c/ir  <—  t5<r(j);   tstr(j)  <—  to-upper  (chr)] 
end  loop; 
g string  <—  ?7(fo£r); 
end; 
This  code  is  used  in  section  42. 
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44. 

(  Procedures  and  Tasks  in  capability   28  )  += 

function  ts_ qualified (yrtask  :  cap_map  .map ;  id  :  natural)return  boolean  is 
expl ,  exp2  :  ExpertiseLevel] 
answer  :  boolean  «—  true] 
yrid  :  deveLnum; 
begin 

yrid  <—  deveLnum(id ); 
for  i  £  1  . .  totaLcaps  loop 

if  cap-map. member (capabilii       j),y        ■  )  then 
expl  *—  cap^map  .fetch(yrtask ,  capabilities  (i))] 
if  cap^map  .member  (capabilities  (i),  developers  (yrid).cmap)  then 
ezpi?  <—  cap^map .fetch(developers  (yrid).cmap ,  capafez7ifoe.s(z)); 
else 

ezpi?  <—  /oiu; 
end  if; 
if  ezpjS  <  ezpl  then 

answer  *— false]  exit; 
end  if; 
end  if; 
end  loop; 
return  answer; 
end  w_ qualified] 
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45. 

(  Procedures  and  Tasks  in  capability  28  )  += 

procedure  prints  capabilities  (yrtask  :  cap^map  .map)  is 
exp  :  Expertiselevel] 

package  exp_io  is  new  enumeration  Ao(Expertiselevel)\ 
use  expAo\ 
kntl  ,knt2  :  cap-num] 
begin 

kntl  <—  1;   knt2  <—  1; 

for  i£  1  ..  totaLcaps  loop 

if  cap-map  .member  (capabilities  (i),yrtask)  then 

kntl  <—  kntl  +  1; 
end  if; 
end  loop; 
put("i")] 
for  i  €  1  •  •  totaLcaps  loop 

if  cap-map.  member  (capabilities  (i),yrtask)  then 

put  (capabilities  (z').all);  put(":u")]   exp  <—  cap-map  .fetch(yrtask ,  capabilities  (i))\ 
pu<(ea;p);  fcntS  <—  A:nt2  +  1; 
if  knt2  <  kntl  then 

ptrfO'.u"); 
end  if; 
end  if; 
end  loop; 
ptit("}"); 
end  print- capabilities ; 
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46. 

(  Procedures  and  Tasks  in  capability  28  )  += 

procedure  prinL capabilities  (fd  :  file_type ;  yrtask  :  cap_map  .map)  is 
exp  :  Expertiselevel] 

package  expAo  is  new  enumeration-io(Expertiselevel); 
use  expAo; 
kntl  ,knt2  :  cap^num; 
begin 

kntl  <—  1;   knt2  <—  1; 

for  i  6  1  . .  totaLcaps  loop 

if  cap.map .member (capabilities  (i),  yrtask)  then 

fcnfi  <—  fcnf./  +  1; 
end  if; 
end  loop; 
put(fd,Hn)] 
for  i  G  1  . .  totaLcaps  loop 

if  cap.map  .member (capabilities  (i),  yrtask )  then 
put(fd,  capabilities  (i). all);  put(fd,  ":u")'i 

exp  <—  cap-map.  fetch  (yrtask,  capabilities  (i))]  put(fd,  exp);   knt2  <—  knt2  +1; 
if  A;n^  <  fcn*l  then 

pu<(/<*,",uM); 

end  if; 
end  if; 
end  loop; 
ptrf  (/(*,»}»); 

end  prinLcapabilities ; 
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47. 

( Procedures  and  Tasks  in  capability  28 )  += 
procedure  prinLcapabilities  (id  :  natural)  is 
exp  :  Expertiselevel; 

package  expAo  is  new  enumeration.™ (Expertiselevel); 
use  exp.io; 
kntl ,  knt2  :  cap.num; 
■grid  :  deveLnum; 
begin 

yrid  «—  deveLnum(id );   fcni/  <—  1;   fcrafi!  <—  1; 
for  i  E  1  •  •  totaLcaps  loop 

if  cap.map  .member  (capabilities  (i),  developers  (yrid). cmap )  then 

fcn</  *—  fcn£.f  +  1; 
end  if; 
end  loop; 
put("{»); 
for  i  E  1  •  •  totaLcaps  loop 

if  cap-map  .member (capabilities  (i),  developers  (yrid). cmap )  then 
put  (capabilities  (i).all);  put  ("  :u")j 

erp  <—  cap.map.  fetch(developers  (yrid).  cmap ,  capabilities  (i));  puf(ezp); 
fcn<2  «-  Jbi*2  +  1; 
if  fcntS  <  fcn£.7  then 

P«*(M.uM); 
end  if; 
end  if; 
end  loop; 
ptrf(">")j 
end  print-  capabilities ; 

48. 

( Procedures  and  Tasks  in  capability  28 )  += 
procedure  print. developers  is 

name  :  ustring; 
begin 

for  i  E  1  . .  totaLdev elopers  loop 

name  <—  get.developer_name(i);  put (S '(name));  put(">u");  print.capabilities  (i); 
newAine; 
end  loop; 
end  print. developers ; 
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49. 

(  Procedures  and  Tasks  in  capability  28  )  += 

function  get-developer-name  (id  :  natural)retum  ustring  is 

yrid  :  deveLnum; 
begin 

yrid  <—  deveLnum(id);  return  U (developers  (yrid). name  .all); 
end  geLdeveloper-name; 

50. 

(  Procedures  and  Tasks  in  capability  28  )  += 

procedure  geLcapability(fd  :  file-type ;  yrcap  :  out  cap -map  .map)  is 

(Variables  local  to  fgeL capability  51 ) 
begin 

chr  <—";*; 

while  chr  ^  *■£"  loop 

get-immediate (fd ,  chr)] 
end  loop; 

j  <—  1;  newstr(j)  <—  '{*; 
while  chr  ^  '}'  loop 

j  <—  j  +  1;  get-immediate  (fd ,  c/ir);  newstr(j)  <—  c/ir; 
end  loop; 
declare 

newstr2  :  String (1  . .  j); 
begin 

for  feGl..j  loop 

newa<r2(fc)  <—  newstr(k)\ 

end  loop; 

<3<r  <—  U(newstr2 ); 
end; 
if  debug  then 

pui  ( "get _capabilitiesu(file)>ucallinguget_capabilitiesu( string) uwithM); 

pwi('*ustringu=uM);  pu2(5(£s<r));   new-line; 
end  if; 

get-capability  (S(tstr),  yrcap ); 
end  geLcapability ; 

51. 

(Variables  local  to  fgeL  capability   51 )  = 

j  :  positive ; 

c^r  :  character; 

newstr  :  String  (1  . .  80); 

ta£r  :  w,s£7"in<7; 
This  code  is  used  in  section  50. 
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52. 

{  Procedures  and  Tasks  in  capability   28  )  += 

procedure  geLcapability(str  :  in  String ;  yrcap  :  out  cap_map  .map)  is  (Variables  local 
to  get-capability   53 ) 
begin 

tstr  <—  U(str)]   indl  *—  index (tstr ,"{");   ind2  *—  index (tstr ,")•"); 
tstr  <—  U(slice(tstr ,  iWi  ,  mrf-2  )); 
if  debug2  then 

pu£ (MParsingustringu'n);  pu2(5(is£r));  puLl»ne("'."); 
end  if; 

£a£r  *—  tail  (tstr,  length  (tstr )  —  indl)]  finished  <—  false;  while  -^finished  loop 
(Get  capability  name  pairs  54)  end  loop;  end  geLcapability; 

53. 

(Variables  local  to  get- capability  53  )  = 

tstr  :  ustring; 

indl  :  natural] 

finished  :  boolean ; 
See  also  sections  56,  58,  and  60. 
This  code  is  used  in  section  52. 

54. 

(  Get  capability  name  pairs  54  )  = 
(  Check  if  finished  55  ) 
if  -^finished  then 

(Get  capability  57) (Get  ExpertiseLevel  59) (Add  new  capability  to  map  61 ) 
end  if; 

This  code  is  used  in  section  52. 

55.      Each  name  pair  is  separated  by  a  colon  ':'.  It  it  is  not  there,  then  we  are  finished. 
(Provided  we  didn't  look  past  the  brace  '}'. 

(  Check  if  finished  55  )  = 

indt  «-  index  (tstr,  ":");   ind3  <-  index  (tstr ,  "}"); 
if  (ind2  =  0)  V  (ind2  >  ind3 )  then 

finished  <—  true] 
end  if; 
if  ind3  =  0  then 

raise  parsecapabilityerror ; 
end  if; 

This  code  is  used  in  section  54. 
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56. 

(Variables  local  to  geL capability  53)  += 
ind2,ind3  -.natural] 

57. 

(  Get  capability  57 )  = 

indl  <— index.non^blank  (tstr);  tstr2  <—  U (slice  (tstr ,  indl  ,ind2  —1)); 

if  debug2  then 

pwi("tstr2u=u");  put(S(tstr2))\   newJine] 

end  if; 

tstr  <—  tail(tstr,length(tstr)  —  ind2); 

if  debug2  then 

put("tstTu=ij");  put(S(tstr))\  newJine] 

end  if; 
This  code  is  used  in  section  54. 

58. 

(Variables  local  to  geLcapability  53)  += 
tstr 2  :  ustring] 

59. 

(  Get  Expertise  Lev  el  59 )  = 

indl  <—  index  (tstr ,"  ,");   ind2  <—  index  (tstr ,"}•"); 
if  indl  =  0  then 

indl  <—  ind2]  finished  <—  true; 
end  if; 

tstr3  <—  U (slice  (tstr ,1,  indl  —1)); 
if  debug2  then 

pw<(,,tstr3u=u");  put (S (tstr 3));   newJine] 
end  if; 

enum-io  .get(S(tstr3),  exp  ,Last)]  tstr  <—  tail  (tstr ,  length  (tstr)  —  indl)] 
if  debug2  then 

put('*tstTu=un);  put(S(tstr))]   newJine; 
end  if; 

This  code  is  used  in  section  54. 

60. 

(Variables  local  to  geLcapability  53)  += 
tstr 3  :  ustring] 
exp  :  Expertise  Lev  el ; 

package  enumJo  is  new  enumeration Jo(ExpertiseLevel)] 
Last  :  positive ; 
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61. 

( Add  new  capability  to  map  61 )  = 

add- capability  (yrcap  ,  S(tstr2 ),  exp  ); 
This  code  is  used  in  section  54. 

62. 

(  Procedures  and  Tasks  in  capability  28  )  += 

function  get-nurti-dev  elopers  return  natural  is 
begin 

return  totaLdev elopers ; 
end  get-num- developers; 

63. 

( Procedures  and  Tasks  in  capability  28  )  += 
procedure  get-developers (infile  :  string)  is 

(Variables  local  to  get-developer  65) 
begin 

(  Open  file  64  )  (  Read  in  developers  66  ) 
end  get-developers; 

64. 

(  Open  file  64 )  = 

open  ( data- file ,  in- file ,  infile ); 
This  code  is  used  in  section  63. 

65. 

( Variables  local  to  get-developer  65 )  = 

data-file  :  file-type; 
See  also  section  68. 
This  code  is  used  in  section  63. 

66. 

( Read  in  developers  66  )  = 

while  -iend-.of-file(data.file)  loop 

(  Get  developer's  name  and  capabilities  67 ) 

end  loop; 
This  code  is  used  in  section  63. 
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67. 

( Get  developer's  name  and  capabilities  67 )  = 

geLline (data-file,  newstr , Last);  tstr  <—  U(newstr);   ind2  *—  index (tstr ,"{"); 
indl  <—  index-non-blank(tstr);  name  <—  U (slice (tstr ,  indl  ,ind2  —1)); 
tstr  <—  tail(tstr,length(tstr)  —  ind2  +  1); 
declare 

yrcap  :  cap-map  .map ; 
begin 

get-capability  (S(tstr),  yrcap  );   create-developer(S(name),  dummy)] 

add. capability  ( deveLnum ( dummy ),  yrcap ); 
end; 

This  code  is  used  in  section  66. 

68. 

( Variables  local  to  get-developer  65 )  += 
Last  :  natural; 
newstr  :  String(\  ..  132); 
indl ,  ind2  :  natural; 
name,  tstr  :  ustring; 
dummy  :  natural; 

69. 

( Procedures  and  Tasks  in  capability  28 )  += 
procedure  put-developers (outfile  :  string)  is 

data-file  :  file-type; 
begin 

create  ( data-file ,  out-file ,  outfile ); 
end  put- developers ; 
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70.  Test  capabilities  driver.  Here,  finally,  is  the  boilerplate.  The  Ada  WEB  tool 
at  angle  reads  this  and  knows  to  write  out  two  separate  files,  the  specification  and  the 
body.  (The  Ada  WEB  tool  aweave  will  write  out  just  one  documentation  file.) 

output  to  file  testcap.adb 

pragma  suppress (alLchecks)] 
with  ustrings] 
use  ustrings  ] 
■with  texLio ; 
use  text-io] 
with  capability; 
use  capability] 

procedure  testcap  is  (Instantiate  generic  packages  71 )( Variables  local  to  testcap  73) 
begin 

(  Test  if  items  are  in  set  72  ) 

( Create  a  task  map  and  see  if  any  developers  qualify  76 ) 

(  Print  out  items  in  set  74 ) 

(  Check  qualifications  75 ) 

(  Try  reading  in  some  capabilities  78  ) 
end  testcap] 

71. 

( Instantiate  generic  packages  71 )  = 

package  nat-io  is  new  integerAo (natural)] 

use  nat-io] 
This  code  is  used  in  section  70. 

72. 

( Test  if  items  are  in  set  72 )  = 

create- developer ("BilluGates",  myid)]  add- capability  (myid,  "Breathing",  High)] 

create. <ieue/oper("ScottuMcNealy",  myid2)]   add- capability  (myid2  ,  "  Java" ,  high); 

create- developer  ("BilluJoy",  myid3  );   add- capability  (my  id3  ,  "Unix",  high)] 

add.  capability  (myid3 ,  "Systemsuprogrannning" ,  high)] 
This  code  is  used  in  section  70. 

73. 

( Variables  local  to  testcap  73 )  = 
myid ,  myidt ,  myidS  :  natural ; 
See  also  sections  77  and  79. 
This  code  is  used  in  section  70. 


217 


TEST  CAPABILITIES  DRIVER  APPENDIX  H         §74 

74. 

(  Print  out  items  in  set  74  )  = 

newJine;  print-capabilities(myid);  newJine;  print- capabilities  (my id2);  newJine; 

print- capabilities  (myidS );  new-line;  print-capabilities  (taskl);  new-line; 
This  code  is  used  in  section  70. 

75. 

(  Check  qualifications  75  )  = 

if  is.  qualified  (task  1 ,  myid)  then 

put-line ("BilluGatesuisuqualif  ied. "); 
end  if; 
if  is-qualified (taskl ,  myid2  )  then 

put-line ("ScottuMcNeallyuisuqualif  ied.  " ); 
end  if; 
if  is-qualified  (taskl ,  myid3  )  then 

puL/me(,,BilluJoyuisuqualified. "); 
end  if; 

This  code  is  used  in  section  70. 

76. 

( Create  a  task  map  and  see  if  any  developers  qualify  76 )  = 

add- capability  (taskl ,  "Unix",  medium); 
This  code  is  used  in  section  70. 

77. 

( Variables  local  to  testcap  73 )  += 
taskl  :  cap-map  .map ; 

78. 

(  Try  reading  in  some  capabilities  78  )  = 

create-developer(n  J o}n\.uEvaiis" ,myid4  );  geLcapability  (testcapstr ,  task2 ); 

print-capabilities  (task2  );   new-line ; 

pu£_/ine("HereuisuBilluJoy  'sucapabilitiesuagain>" );  print-capabilities  (myid3  ); 

puLline ( "Hereuareuallutheudeveloper ' sucapabilit iesuagain . " ); 

print- developers  ;  get-developers  ("developers .  txt" );  print- developers ; 
This  code  is  used  in  section  70. 

79. 

( Variables  local  to  testcap  73  )  += 
testcapstr      :      String      <— 

"{Unix :  high ,  Ada :  high ,  Xwindows :  medium,  Sy  st  emsuProgr  annning :  medium}" ; 
task 2  :  cap -map  .map ; 
myidj  :  natural; 
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80.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  TESTCAP  work  at  a  particular  instal- 
lation. It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  mod- 
ules preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

81.  RCS  Keywords. 

$RCSfile:  capability.aweb,v 

$  Revision:  1.1 

$Date:  1997/09/05  00:31:42 

$Author:  evansjr 

$Id:  capability.aweb,v  1.1  1997/09/05  00:31:42  evansjr  Exp  evansjr 

$Locker:  evansjr 
$  State:  Exp 
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82.  Index.  Here  is  a  cross-reference  table  for  the  TESTCAP  program.  All  modules  in 
which  an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are 
indexed  only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers 
in  module  names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  corre- 
spond to  sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond 
to  the  section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


acap:     33,  35-38. 

Ada:     11. 

add:     31,  33,  35,  42. 

add. capability :     15,  33,  34,  35,  41,  61, 

67,  72,  76. 
alLchecks:  70. 
answer:     44. 

Astring:     12,  21,  25-27,  33,  35. 
A  String:     12. 
badid:     13,  35. 
bind:     30-33,  39-40. 
boolean:     18,  23,  27,  33,  35,  44,  53. 
cap- array :     26. 
cap-map :     12,  15-19,  27-28,  30-34,  39-41, 

44-47,  50,  52,  67,  77,  79. 
cap-num:  26,  33,  35,  45-47. 
cap-rec:     27. 

capset:     21,  24,  26,  31,  33,  35,  42. 
capabilities  :     26,  30-35,  38-47. 
capability:     11 ,  21,  70. 
capability .adb  :     11. 
capability. ads  :     11. 
Character:     43. 
character:     51. 
Characters:      11. 
chr:     43,  50-51. 
cmap:     27,30-32,39-41,44,47. 
copy- capability :     16,  41. 
create  :     69. 

create. developer:     14,  28,  67,  72,  78. 
data-file:     64-67,  69. 
debug:     23,  31,  39,  50. 
debugt:     23,  32,  52,  57,  59. 
deveLnum:     12,  15,  21,  27-28,  32,  34-35, 

40-41,  44,  47,  49,  67. 


developer:     14,  28,  31-32. 

dev  eloper- array :     27. 

developers:     27,  29-32,  35,  39-41,  44, 

47,  49. 
dummy:     67-68. 
empty:     42. 
end- of- file:     66. 
enum-io:     35,  39,  59,  60. 
enumeration-io :     35,  45-47,  60. 

exp:     15,33,35,39-40,45-47,59-61. 

exp-io:     45,  46,  47. 

ExpertiseLevel:     12,  15,  33-35,  41,  44,  60. 

Expertiselevel:     45-47. 

expl:     34,  41,  44. 

exp2 :     44. 

false:     23,  27,  38,  44,  52. 

fd:     17,  19,  46,  50. 

fetch:     34,  41,  44-47. 

file-type:     17,  19,  46,  50,  65,  69. 

finished:     52-55,  59. 

generic-map-pkg:     11-12. 

genericset-pkg:     11,  21. 

get:     59. 

get-capability :     19,  50,  52,  67,  78. 

get- dev  eloper-name:     17,  36,  39,  41, 

48,  49. 
get-developers:     20,  63,  78. 
get-immediate :     50. 
get-line:     67. 

get-num-dev elopers  :     20,  62. 
globalcaps:     24,31,33,35,42. 
gstring:     23,  42-43. 
handling:     11. 

High:     72. 

high:     12,  31,  72. 
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i:     30,  32,  34,  38,  40,  41,  42,  44,  45, 

46,  47,  48. 
id:     15,  17-18,  32,  34-35,  44,  47,  49. 
in- file :     64. 
index:     52,  55,  59,  67. 
index-non-blank :     57,  67. 
indl :     52-53,  57,  59,  67-68. 
ind2 :     52,  55-57,  59,  67-68. 
ind3 :     55-56. 
infile:     20,  63-64. 
integer Ao:     71. 
inuse:     27,  29,  32,  35,  40. 
is-member:     33,  35,  38. 
is-qualified:     18,  44,  75. 
j:     36,  37,  43- 
k:     50. 
key:     12. 

knt:     28-31,  33,  35,  38-39. 
kntl :     45-47. 
knt2 :     45-47. 
Last:     59-60,  67-68. 
/en^/i:     36-37,  43,  52,  57,  59,  67. 
low:     12,  30,  32,  40,  44. 
map:     15-19,  27-28,  33-34,  41,  44-46, 

50,  52,  67,  77,  79. 
max-dev  elopers:     21. 
MAX  CAPS:     26. 
medium:     12,  76. 
member:     34,  41,  44-47. 
my  caps :     26. 
rnyi<£:     72-75. 
myi^ :     72-75. 
myid3:     72-75,  78. 
myi^ :     78-79. 

name:     27,31-32,36,48-49,67-68. 
namel :     41. 
name2:     41. 
naLio :     71. 
na<uraZ:     14-18,  20-21,  24,  26,  28-29, 

34-36,  39,  41,  44,  47,  49,  53,  56, 

62,  68,  71,  73,  79. 
new.line :     39,  48,  50,  57,  59,  74,  78. 
newstr:     67-68. 


newstr:     50-51. 

newstr2:     50. 

open:     64. 

out-file:     69. 

outfile:     69. 

pars  ecap  ability  error :     13,  55. 

positive:     51,  60. 

prinLcapabilities :     17,  45,  46,  47,  48, 

74,  78. 
print-developers:     17,  31,  48,  78. 
put:     32,  39,  45-48,  50,  52,  57,  59. 
put-developers :     69. 
puUine:     32,  52,  75,  78. 
result:     12. 
set:     21,  24,  26. 
slice:     52,  57,  59,  67. 
str:     19,  25,  52. 
String:     12,  14-15,  19,  28,  33,  35,  43, 

50-52,  68,  79. 
string:     20,  25,  36-37,  63,  69. 
strings:     11. 
Strings:     11. 
suppress :     70. 
system  dependencies:     80. 
tail:     52,  57,  59,  67. 
taskl :     71-11. 
task2 :     78-79. 
test-io-pkg:     11. 
testcap:     70. 
test cap. adb  :      70. 
testcapstr:     78-79. 
TEXTJO:     11. 
text-io :     70. 
tmpcap :     28. 
to-upper:     36-37,  43. 
totaLcaps:     26,  30-35,  38,  40-42,  44-47. 
totaLdevelopers:     24,  29,  48,  62. 
true:     29,  38,  44,  55,  59. 
tstr:     36-37,  43,  50-53,  55,  57,  59,  67-68. 
tstr2:     57-58,  61. 
tstr  3 :     59-60. 
Unbounded:     11. 
unchecked-  deallocation :     11. 
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Use:     11. 

ustring:     17,  36,  41,  48-49,  51,  53,  58, 

60,  68. 
Ustring:     23. 
U strings:     11. 
ustrings:     11,  70. 
yr:     41. 

yrcap:     15-16,  19,  33-37,  41,  50,  52, 

61,  67. 

grid:     14-16,  28-29,  34-36,  39-41,  44, 

47,  49. 
yrtask:     15,  17-18,  33,  44-46. 
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Add  new  capability  to  map  61 )      Used  in  section  54. 

Add  this  capability  to  all  the  other  developers  32 )      Used  in  section  31. 

Add  to  all  developers  40  )       Used  in  section  35. 

Assign  capabilities  to  him  30  )       Used  in  section  28. 

Check  if  finished  55  )      Used  in  section  54. 

Check  qualifications   75  )      Used  in  section  70. 

Convert  to  upper-case  36 ) 

Convert  to  uppercase  43  )       Used  in  section  42. 

Create  a  task  map  and  see  if  any  developers  qualify  76  )     Used  in  section  70. 

Create  capability  out  of  his  name  31 )      Used  in  section  28. 

Fetch  an  unused  developer  29  )      Used  in  section  28. 

First  convert  to  upper-case  37  )       Used  in  sections  33  and  35. 

Get  capability   57  }      Used  in  section  54. 

Get  developer's  name  and  capabilities  67  )      Used  in  section  66. 

Get  ExpertiseLevel   59  )      Used  in  section  54. 

Get  capability  name  pairs  54  )      Used  in  section  52. 

Initialize  capabilities  42  )      Used  in  section  11. 

Instantiate  generic  packages  71 )      Used  in  section  70. 

Open  file  64  )      Used  in  section  63. 

Package  boiler-plate  11 )     Used  in  section  10. 

Print  out  items  in  set  74  )      Used  in  section  70. 

Procedures  and  Tasks  in  capability  28,  33,  34,  35,  41,  44,  45,  46,  47,  48,  49,  50,  52,  62,  63,  69 ) 

Used  in  section  11. 
Read  in  developers  66  )       Used  in  section  63. 

See  if  already  in  capabilities  array  38  )     Used  in  sections  33  and  35. 
Specification  of  private  types  in  capability  21 )     Used  in  section  11. 
Specification  of  procedures  visible  from  capability   14,  15,  16,  17,  18,  19,  20 ) 

Used  in  section  11. 
Specification  of  types  and  variables  visible  from  capability   12,  13)     Used  in  section  11. 
Test  if  items  are  in  set   72  )      Used  in  section  70. 
Try  reading  in  some  capabilities  78  )     Used  in  section  70. 
Update  capabilities  of  this  developer  39 )     Used  in  section  35. 
Variables  and  types  local  to  capability  23,  24,  25,  26,  27  )     Used  in  section  11. 

Variables  local  to  testcap   73,  77,  79  )       Used  in  section  70. 
Variables  local  to  fget-capability   51 )     Used  in  section  50. 
Variables  local  to  get_capability    53,  56,  58,  60  )       Used  in  section  52. 
Variables  local  to  get-developer  65,  68 )      Used  in  section  63. 
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1.  Introduction.  This  routine  generates  a  number  of  tasks  for  which  a  valid  schedule 
exists.  The  output  of  this  routine  is  fed  into  the  scheduling  algorithm  to  test  its  perfor- 
mance. This  particular  version  uses  the  capability  model  described  in  my  thesis. 

2.  This  is  the  main  routine  that  starts  everything. 

output  to  file  task  generator .  adb 

pragma  Unsuppress(alLchecks); 

with  CALENDAR; 

use  CALENDAR; 

with  text-io; 

use  text-io; 

(  Needed  packages  10 ) 

procedure  task- generator  is 

package  naLio  is  new  integer Ao (natural); 
use  nat-io; 

package  flt-io  is  new  floaLio (float); 
use  flt-io; 

package  booLio  is  new  enumeration-io (boolean); 
use  booLio; 

( Variables  local  to  task- generator  6 ) 
( Functions  local  to  task-generator  33  ) 
begin 

(  Get  input  parameters  4 ) 
declare 

( Allocate  a  static  array  to  hold  tasks  for  schedule  12  ) 
begin 

( Compute  earliest  available  time  (EAT)  in  resource  matrix  15) 

R  <—  laxity; 

for  i  6  1  . .  tasks  loop 

(  Generate  another  task  16 ) 
end  loop; 
if  do-alternate  then 

(  Convert  to  calendar  time  35  ) 
end  if; 

(  Print  out  results  34 ) 
end; 
end  task- generator; 
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3.  This  routine  takes  two  input  parameters.  (1)  "-tasks"  the  number  of  tasks  to 
generate;  and  (2)  "-laxity"  the  laxity,  or  tightness,  parameter.  This  is  formally  defined 
as 

Td  —  Teat  +  Tp 

where  Td  is  the  deadline,  Teat  is  the  earliest  start-time,  and  Tp  is  the  processing  time.  It 
is  computed  apriori  by  the  task- generator . 

TD  =  (1  +  R)  *  SC 

where  R  is  an  input  parameter,  and  SC  is  the  shortest  completion  time. 

4.  The  input  values  are  read  in  using  the  routines  in  package  getopt .  I  read  in  the  number 
of  tasks  to  compute,  the  "laxity"  of  the  schedule,  and  a  "seed"  for  the  random  number 
generator. 

(  Get  input  parameters  4  )  = 
tasks  <—  10; 
if  option^present (U ("-tasks"))  then 

geLoption ({/("-tasks"), param);  get(S(param),  tasks, Last); 
end  if; 
laxity  <—  0.0; 
if  option-present  ({/("-laxity"))  then 

get-option  ({/("-laxity"),  param)]  get(S  (param),  laxity ,  Last); 
end  if; 
seed  <-  68069; 
if  option-present(U(" -seed"))  then 

geLoption ({/("-seed"), param);  g et(S '(param), seed , Last); 
end  if; 

(  Get  NRaD  option  5 ) 
(  Get  developer  file  7  ) 
(  Get  developers  8 ) 
This  code  is  used  in  section  2. 

5. 

( Get  NRaD  option  5 )  = 

if  option_present(U("-iLraid"))  then 

get-option (U (" -TXTdid") , param );  get(S(param), nrad , Last); 
else 

nrad  «—  true; 
end  if; 

See  also  section  45. 

This  code  is  used  in  section  4. 
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6. 

( Variables  local  to  task- generator  6  )  = 

tasks  :  natural; 

laxity  :  float ; 

Last  :  positive ; 

param  :  U string; 

seed  :  natural; 

nrad  :  boolean ; 
See  also  sections  9,  13,  18,  19,  22,  26,  29,  30,  32,  37,  41,  44,  and  46. 
This  code  is  used  in  section  2. 

7. 

(  Get  developer  file  7 )  = 
if  name-present{\)  then 

getjname  (devfile ,  1); 
else 

raise  nofilename; 
end  if; 

This  code  is  used  in  section  4. 

8. 

( Get  developers  8 )  = 

get-developers  (S  (devfile));   num-dev  elopers  <—  geLnuni-dev elopers; 
This  code  is  used  in  section  4. 

9. 

( Variables  local  to  task- generator  6 )  += 
nofilename  :  exception; 
devfile  :  ustring; 
num-developers  :  natural; 

10.  We  need  some  more  packages  to  read  in  the  parameters.  Specifically  the  package 
getopt  written  by  this  student;  and  the  package  Ustrings — used  for  manipulating  "un- 
bounded" strings. 

(  Needed  packages  10  )  = 

with  Ustrings; 

use  Ustrings; 

with  GetOpt; 

use  GetOpt; 
See  also  sections  11,  14,  24,  and  39. 
This  code  is  used  in  section  2. 


229 


INTRODUCTION  APPENDIX  I         §11 

11.      We  also  add  the  following  package  to  enhance  the  capability  model  the  scheduler 
(and  task- generator)  can  use. 

(  Needed  packages  10  )  += 
with  capability, 
use  capability; 

12. 

( Allocate  a  static  array  to  hold  tasks  for  schedule  12 )  = 

sched  :  array  (1  . .  tasks)  of  StepRecord; 

newsched  :  array  (1  . .  tasks)  of  New  Step  Record; 

mysample  :  booLarray{\  ..  tasks); 
See  also  section  31. 
This  code  is  used  in  section  2. 

13. 

( Variables  local  to  task- generator  6 )  += 
type  New  Step  Record  is 
record 

CalDuration  :  Duration; 
CalStartTime  :  Time; 
CalDeadLine  :  Time; 
end  record; 

14. 

(  Needed  packages  10  )  += 
with  genericset-pkg; 
with  SchedPrims ; 
use  SchedPrims ; 

15. 

( Compute  earliest  available  time  (EAT)  in  resource  matrix  15 )  = 
MATRIX_MIN{EAT,  Min,  COL); 

This  code  is  used  in  sections  2  and  28. 
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16. 

{  Generate  another  task  16 )  = 

(  Compute  duration  of  task  T„p  17  ) 

(  Compute  predecessors  25  ) 

(  Compute  earliest  start  time  20 ) 

(  Compute  deadline  T.D  21 ) 

(  Compute  priority  P  23 ) 

sched  (i).StepID  <— i]  sched  (i).  Deadline  <—  T-D\  sched  (i). Priority  <—  P; 

sched(i).EstimatedDuration  <—  T_p;   (Assign  expertise  level  27) 

(  Update  resource  matrix  28  ) 
This  code  is  used  in  section  2. 

17.  The  duration  varies  in  length  between  MIN-D  and  MAX-D .  The  duration  will  not 
go  over  the  maximum  task  deadline  (MTD). 

(  Compute  duration  of  task  T_p  17 )  = 

T_p  «-  uniform (MIN.D ,  MAX-D );     {  duration  } 

This  code  is  used  in  section  16. 

18.  Minimum  task  duration. 

( Variables  local  to  task- generator  6 )  += 
Min-D  :  natural  <—  2; 

19.  Maximum  task  duration. 

( Variables  local  to  task- generator  6 )  += 
Max-D  :  natural  *—  10; 

20. 

(  Compute  earliest  start  time  20  )  = 
for  j  E  1  .  •  (i  —  1)  loop 

if  naLset .member (j , sched(i). predecessors)  then 

if  Sched(j). deadline  >  sched(i).EarliestStartTime  then 
sched [i).EarliestStartTime  <—  Sched(j). Deadline; 
if  debug  then 

pu*(MModifieduSched.(n);  put(i,l);  put(")utoubeu"); 
put  (sched  (i).EarliestStartTime ,  1);  puLline("  .u")> 
end  if; 
end  if; 
end  if; 
end  loop; 
This  code  is  used  in  section  16. 
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21.      The  deadline  (T-D)  is  a  function  of  the  duration  and  the  least  value  of  a  resource 
in  the  resource  matrix. 

(  Compute  deadline  T-D  21 )  = 

TT  <-  integer  (float  (T.p)*  (1.0  +  laxity))] 
if  debug  then 

pu^'Oldudeadlineuisu" );  put(sched(i). Deadline ,1);  pu£("  .u")j 
end  if; 
if  sched(i).EarliestStartTime  >  EAT  (COL)  then 

T_J9  «—  TT  +  sched(i).EarliestStartTime; 
else 

T_Z>  <-  TT  +  JEAr(C      ); 
end  if; 
if  debug  then 

pui("Newudeadlineuisu");  puf(T_jD,l);  pti£_7»ne(" .u")j 
end  if; 

This  code  is  used  in  section  16. 

22. 

( Variables  local  to  task-generator  6 )  += 
debug  :  boolean  <—  false; 
debugt  :  boolean  <— false; 

23.      A  random  value. 

(  Compute  priority  P  23 )  = 

P  <—  uniform (4, 10); 
This  code  is  used  in  section  16. 

24. 

(Needed  packages  10  )  += 
with  Probability; 
use  Probability; 
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25.  I  choose  to  select  M  out  of  N  tasks  as  predecessors.  M  has  an  upper  limit  of 
Max-Predecessors  and  N  is  the  number  of  previous  tasks  assigned.  If  the  number  of 
previous  tasks  scheduler  is  less  than  Max-Predecessors  then  the  minimum  is  selected  then 
the  upper  limit  is  the  number  of  previous  tasks  scheduled.  M  is  selected  randomly. 

{  Compute  predecessors  25  )  = 
if  do-predecessor  then 

if  i  <  Max-Predecessors  then 

ptasks  <—  (i  —  1); 
else 

ptasks  <—  Max-Predecessors ; 
end  if; 

nsamp  <—  uniform(Q,  ptasks  ); 
if  i  >  1  then 

sample(nsamp  ,i  —  1,  my  sample); 
for  j  G  1  . .  (i  —  1)  loop 
if  mysample(j)  then 

tl  <—  natset. size (Sched(i). Predecessors); 

t2  <—  nat_set.size(Sched(j). Successors); 

if  (tl  <  Max_Predecessors  )  A  (t2  <  Max^Predecessors  )  then 

naLset.add(j,  Sched(i). Predecessors  );   naLset.add(i,  Sched (j). Successors  ); 
end  if; 
end  if; 
end  loop; 
end  if; 
end  if; 

This  code  is  used  in  section  16. 

26. 

( Variables  local  to  task- generator  6  )  += 
Max-Predecessors  :  constant  natural  <—  0; 
ptasks  ,  nsamp  :  natural; 
tl  ,t2  :  natural ; 

27. 

( Assign  expertise  level  27  )  = 
declare 

tmpcap  :  cap- map  .map ; 
begin 

copy_capability  (COL,  sched  (i).ExpLevel); 
end; 

This  code  is  used  in  section  16. 
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28. 

(  Update  resource  matrix  28 )  = 
if  debug  then 

pM<(nBeforeuUpdate:un);  put("EAT(");  put(COL,l);  put(n)u=u")] 

put{E  AT  (COL),  1);  puUine("  .u"); 
end  if; 

EAT(COL)+-  T-D; 
if  debug  then 

pM<("AfteruUpdate:uM);   pu*("EAT(");  puf(COL,l);  pu*(")u=u"); 

pu*(£y4T(COL),l);  puL/me(M.u"); 
end  if; 

(  Compute  earliest  available  time  (EAT)  in  resource  matrix  15  ) 
This  code  is  used  in  section  16. 

29. 

(Variables  local  to  task- generator  6)  += 
R  :  float  <-  0.7; 
R3  :  natural  <—  3;     { laxity  } 
UU  :  natural  <—  1; 
Ul  :  natural  <—  3;     {  seed  } 
U2  :  natural  *—  1; 

type  RESOURCE-MATRIX  is  array  (POSITIVE  range  <>)  of  natural; 
do -predecessor  :  BOOLEAN  *—  true; 

30.  Max  task  deadline. 

( Variables  local  to  task- generator  ^  )  += 
MTD  :  natural  +-  70000; 

31.  The  way  this  is  denned,  it  "hard-codes"  the  maximum  number  of  designers  per  leve 
to  '2.'  (Must  be  in  concordance  with  the  maximum  number  of  designers  defined  above.) 

( Allocate  a  static  array  to  hold  tasks  for  schedule  12 )  -f-= 

EAT  :  RESOURCE-MATRIX (1  ..  num-developers)  +-  (others   =J>  0); 

32. 

( Variables  local  to  task- generator  6 )  += 
P,  T-D ,T-p,Rl,R2,C  :  natural ; 
Min  :  natural  <—  0; 
COL  :  natural  <—  1; 
COUNT  :  natural  *-  0; 
TT  :  integer; 
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33.  This  finds  the  smallest  value  in  the  resource  matrix  and  returns  the  index  of  the 
minimum  value. 

(  Functions  local  to  task-generator  33  )  = 

procedure  MATRIX-MIN  (MATRIX  :  in  RESOURCE-MATRIX ;MIN  :  out 
natural;  Kl  :  out  natural)  is 
Mini  :  natural  <-  MATRIX (1); 
begin 
Kl   4-1; 

for  j  €  2  . .  MATRIX 'Length  1    -p 
if  Mini  >  MATRIX  (j)  the 

Mini  4-  MATRIX  (j);  Kl  <-j; 
end  if; 
end  loop; 
MflV  «-  Mini ; 
end  MATRIX-MIN; 

This  code  is  used  in  section  2. 

34.  Procedure  PuLset  is  declared  in  package  schedprims . 

( Print  out  results  34 }  = 
for  i  £  1  . .  £a.sfc.s  loop 
if  ~^do- alternate  then 

put(sched(i). Deadline, 4);  put(sched(i). Priority ,4); 

put(sched (i).EstimatedDuration ,5);  put(sched(i).EarliestStartTime,5); 

{earliest  start  time} 
pu<("u");  putset(Sched(i). Predecessors);  put("u");  putset(Sched(i). Successors); 
put(,%un);  print-capabilities(Sched(i).ExpLevel);   new-line; 
else 

print- date  (news ched(i).CalDeadline);  put(sched(i).  Priority  ,5); 
put(sched(i).EstimatedDuration,5);  put("u"); 

prinL  date  (news  ched(i).CalStartTime);  put("u")\  puts  et(Sched(i).  Predecessors  ); 
pttf(Mu");  putset(Sched(i).  Successors);  put("u"); 
print- capabilities  (Sched(i). Exp Level);   new-line; 
end  if; 
end  loop; 
This  code  is  used  in  section  2. 
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35. 

( Convert  to  calendar  time  35 )  = 
(  Get  start  date  36  ) 
Start-Time  <—  Current-Time; 
for  i  G  1  . .  tasks  loop 

( Convert  Start  Time  to  Calendar  Time  43 ) 
(  Convert  Task  Duration  to  Duration  type  42  ) 
( Convert  Deadline  to  Calendar  Time  47 ) 
end  loop; 
This  code  is  used  in  section  2. 

36.     For  now  "hard-code"  a  date  (July  1st,  1997). 

( Get  start  date  36 }  = 

Current-Time  <—  Time.of  (1997,  7,3);  (Find  first  work-day  38)  ifdebug2    then  (Print 
out  first  work  day  40 )  end  if; 
This  code  is  used  in  section  35. 

37. 

( Variables  local  to  task- generator  6 )  += 
Current-Time ,  Start-Time  :  Time] 
do-alternate  :  boolean  +—  false; 

38. 

(  Find  first  work-day  38  )  = 

while  (->Is WorkDay (Current-Time, nrad))  loop 

Current-Time  <—  Current-time  +  Day-Duration' Last; 

end  loop; 
This  code  is  used  in  section  36. 

39.      Package  to  find  federal  off-days  till  year  2099  (barring  acts  of  God,  or  Congress). 

(  Needed  packages  10  )  -f-= 
with  calyr; 
use  calyr; 

40. 

(  Print  out  first  work  day  40  )  = 

Split  (Current- Time ,  Year ,  Month ,  Day ,  Seconds  );  put("Th.euf  irstuworkudayuisu"); 
put(Month,3);  put("/");  put(Day,3);  put("/");  put(Year,4);  puUine(" ."); 

This  code  is  used  in  section  36. 
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41. 

(  Variables  local  to  task- generator  6  )  += 
Year  :  Year-number; 
Month  :  Month-number ; 
Day  :  Day-Number; 
Seconds  :  Day-Duration; 

42. 

( Convert  Task  Duration  to  Duration  type  42 )  = 

newsched(i). CalDuration  <—  ConvertHourstoDuration(sched(i).EstimatedDuration ); 
This  code  is  used  in  section  35. 

43. 

( Convert  Start  Time  to  Calendar  Time  43 )  = 

TotalTime  <—  C  onvertHoursToDuration(S  ched  (i)  .EarliestStartTime); 
newsched(i).CalStartTime  <—  DurationTo  Calendar Time  (Start-Time ,  dailyhours  , 

TotalTime ,  NRad ); 
if  debug2  then 

testduration  <—  CalendarTimetoDuration (Start- Time,  dailyhours , 

newsched  (i).  CalStartTime ,  NRaD ); 
testhours  *—  ConvertDurationToHours(testduration); 
if  sched(i).EarliestStartTime  ^  testhours  then 

pu<("ERRORuinuCalendarTimetoWorkHours" );   new-line ; 
pu<(MCalendarTimeureturnedu");  put  (testhours); 

pu<("uanduitushoulduhaveureturnedu");  put(sched(i).EarliestStartTime); 
put(".");  J>uf(,,(NRaD)u=u,,);  put(NRaD);  put(")  .");   newJine; 
pw<("TheuStartuTimouisu,, );  print-date(StarLTime); 
ptt<(M.uTheuTotalTimeuisuM);  put  (float  (TotalTime)); 
pw<("Inuhoursuthatuisu");  put(ConvertDurationtoHours(  TotalTime)); 
put (")");  put("  -uu")?  new-line; 
end  if; 
end  if; 
This  code  is  used  in  section  35. 

44. 

( Variables  local  to  task- generator  6 )  += 
testduration  :  Duration; 
testhours  :  natural; 
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45. 

( Get  NRaD  option  5 )  += 
for  day  £  Mon  . .  Thu  loop 
if  nrad  then 

daily  hours  (Day)  «—  9.0  *  SecondsPerHour; 
else 

daily  hours  (Day)  <—  8.0  *  SecondsPerHour ; 
end  if; 
end  loop; 
dailyhours  (Fri)  <—  8.0  *  SecondsPerHour] 

46. 

( Variables  local  to  task-generator  6 )  += 
dailyhours  :  Worfc/iou7\s ; 

SecondsPerHour  :  constant  Duration  *—  3600.0; 
TotalTime  :  duration; 

47. 

( Convert  Deadline  to  Calendar  Time  47 )  = 

TotalTime  <—  ConvertHoursToDuration(Sched(i). Deadline); 

newsched(i).CalDeadline  <—  DurationTo Calendar  Time  (St art-Time ,  dailyhours  , 
TotalTime ,  NRad ); 
This  code  is  used  in  section  35. 
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48.  System-dependent  changes.  This  module  should  be  replaced,  if  necessary,  by 
changes  to  the  program  that  are  necessary  to  make  MAIN  work  at  a  particular  installation. 
It  is  usually  best  to  design  your  change  file  so  that  all  changes  to  previous  modules 
preserve  the  module  numbering;  then  everybody's  version  will  be  consistent  with  the 
printed  program.  More  extensive  changes,  which  introduce  new  modules,  can  be  inserted 
here;  then  only  the  index  itself  will  get  a  new  module  number. 

49.  RCS  Keywords. 

$RCSnle:  task-generator. aweb,v 

$Revision:  1.3 

$Date:  1997/09/05  00:35:25 

$Author:  evansjr 

$Id:  task-generator. aweb,v  1.3  1997/09/05  00:35:25  evansjr  Exp  evansjr 

$Locker:  evansjr 
$State:  Exp 
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50.  Index.  Here  is  a  cross-reference  table  for  the  MAIN  program.  All  modules  in  which 
an  identifier  is  used  are  listed  with  that  identifier,  except  that  reserved  words  are  indexed 
only  when  they  appear  in  format  definitions,  and  the  appearances  of  identifiers  in  module 
names  are  not  indexed.  Underlined  entries  of  subprograms  and  packages  correspond  to 
sections  where  this  entity  is  specified,  whereas  entries  in  italic  type  correspond  to  the 
section  where  the  entity's  body  is  stated.  For  any  other  identifier  underlined  entries 
correspond  to  where  the  identifier  was  declared.  Error  messages  and  a  few  other  things 
like  "ASCII  code"  are  indexed  here  too. 


add:     25. 

alLchecks:     2. 

booL  array:     12. 

booLio:     2. 

boolean :     2,  6,  22,  37. 

BOOLEAN:     29. 

CalDeadline:     34,  47. 

CaffleadLine :     13. 

CalDuration:     13,  42. 

CALENDAR:     2. 

Calendar  Timeto  Duration:     43. 

CalStartTime:     13,  34,  43. 

calyr :     39. 

cap-map:     27. 

capability:     11. 

COL:     15,  21,  27-28,  32. 

ConvertDurationtoHours:     43. 

ConvertDurationToHours:     43. 

ConvertHoursToDuration:     43,  47. 

ConvertHourstoDuration:     42. 

copy_  capability :     27. 

COUNT:     32. 

CurrenLTime:     35-38,  40. 

CurrenLtime:     38. 

daily  hours  :     43,  45-47. 

day :     45. 

Day:     40-41,  45. 

Day-Duration:     38,  41. 

Day-Number:     41. 

Deadline:     16,  20-21,  34,  47. 

deadline :     20. 

debug:     20-22,  28. 

debugt:     22,  36,  43. 

devfile:     7-9. 

do„ alternate:     2,  34,  37. 


do-predecessor :     25,  29. 

duration :     46. 

Duration:     13,  44,  46. 

DurationTo  Calendar  Time :     43,  47. 

EarliestStartTime:     20-21,  34,  43. 

EAT:     15,  21,  28,  31. 

enumeration -io:     2. 

EstimatedDuration:     16,  34,  42. 

ExpLevel:     27,  34. 

false:     22,  37. 

float:     2,  6,  21,  29,  43. 

floaLio :     2. 

flLio :     2. 

Fri:     45. 

genericset-pkg:     14. 

get:     4-5. 

get-developers:     8. 

get-name:     7. 

get-num-developers :     8. 

geLoption:     4-5. 

getopt:     4,  10. 

GetOpt:     10. 

z:     2,  34,  35- 

integer:     21,  32. 

integer-io :     2. 

Jj  WorJfeUay :     38. 

j:     20,  25,  33- 

#i :     33. 

Last:     4-6,  38. 

laxity:     2,  4,  6,  21. 

Length:     33. 

map :     27. 

MATRIX:     33. 

MATRIX.MIN:     15,  33- 

AL4X_Z>:     17. 
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Max-D:     19. 

Max-Predecessors :     25-26. 

member:     20. 

MIN:     33. 

Min:     15,  32. 

M/O:     17. 

Min-D:     18. 

Mini :     33. 

Mon:     45. 

Month:     40-41. 

Month^number:     41. 

MTD:     17,  30. 

mysample:     12,  25. 

name-present:     7. 

nat-io :     2. 

natset:     20,  25. 

natural:     2,  6,  9,  18-19,  26,  29-30, 

32-33,  44. 
new-line:     34,  43. 
newsched:     12,  34,  42-43,  47. 
NewStepRecord :     12,  13. 
nofilename :     7,  9. 
nrad:     5-6,  38,  45. 
iViW:     43,  47. 
JVflaD :     43. 
nsamp :     25-26. 
num-dev  elopers:     8-9,  31. 
option^present:     4-5. 
param:     4—6. 
positive :     6. 
POSITIVE:     29. 
Predecessors  :     25,  34. 
predecessors :     20. 
print-  capabilities :     34. 
print-date:     34,  43. 
Priority:     16,  34. 
Probability :     24. 
ptasks :     25-26. 
pu*:     20-21,  28,  34,  40,  43. 
putJine:     20-21,  28,  40. 
putset:     34. 
Putset:     34. 
RESOURCE-MATRIX:     29,31,33. 


fll: 

32 

#2: 

32 

#,?: 

29 

45-46. 


35,  37,  43,  47. 


48. 


sample :     25. 

Sc/ie<f:     20,  25,  34,  43,  47. 

acfcei :     12,  16,  20-21,  27,  34,  42-43. 

SchedPrims :     14. 

schedprims :     34. 

Seconds:     40-41. 

SecondsPerHour 

seed:     4,  6. 

size:     25. 

Split:     40. 

Start-  Time : 

StepID:     16. 

StepRecord:     12. 

Successors :     25,  34. 

system  dependencies: 

T_P:     16,  21,  28,  32. 

T-p:     16-17,  21,  32. 

task-generator:     2,  3,  11. 

task_generator.adb  :     2. 

<<wib:     2,  4,  6,  12,  34-35. 

testduration:     43-44. 

testhours :     43-44. 

text-io:     2. 

Thu:     45. 

Time:     13,  37. 

Time-of :     36. 

tmpcap :     27. 

TotalTime:     43,  46-47. 

irue:     5,  29. 

TT:     21,  32. 

« :     25-26. 

tS:     25-26. 

uniform:     17,  23,  25. 

Unsuppress :     2. 

ustring :     9. 

U string:     6. 

U strings :     10. 

TO:     29. 

tfi :     29. 

tf-2 :     29. 
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Workhours:     46. 
Year:     40-41. 
Year_number :     41. 
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Allocate  a  static  array  to  hold  tasks  for  schedule  12,  31 )     Used  in  section  2. 
Assign  expertise  level  27  )       Used  in  section  16. 
Compute  deadline   T_D    21  )      Used  in  section  16. 
Compute  duration  of  task  T_p   17 )      Used  in  section  16. 

Compute  earliest  available  time  (EAT)  in  resource  matrix  15  )      Used  in  sections  2  and  28. 
Compute  earliest  start  time  20  )      Used  in  section  16. 
Compute  predecessors  25  )      Used  in  section  16. 
Compute  priority  P  23  )       Used  in  section  16. 
Convert  Deadline  to  Calendar  Time  47  )      Used  in  section  35. 
Convert  Start  Time  to  Calendar  Time  43 )     Used  in  section  35. 
Convert  Task  Duration  to  Duration  type  42  )     Used  in  section  35. 
Convert  to  calendar  time  35 )     Used  in  section  2. 
Find  first  work-day  38  )      Used  in  section  36. 
Functions  local  to  task-generator  33  )     Used  in  section  2. 
Generate  another  task  16  )     Used  in  section  2. 
Get  NRaD  option  5,  45  )      Used  in  section  4. 
Get  developer  file  7  )      Used  in  section  4. 
Get  developers  8  )       Used  in  section  4. 
Get  input  parameters  4 )      Used  in  section  2. 
Get  start  date   36  )      Used  in  section  35. 
Needed  packages   10,  11,  14,  24,  39  )      Used  in  section  2. 
Print  out  first  work  day  40  )      Used  in  section  36. 
Print  out  results  34  )      Used  in  section  2. 
Update  resource  matrix  28  )     Used  in  section  16. 

Variables  local  to  task-generator   6,  9,  13,  18,  19,  22,  26,  29,  30,  32,  37,  41,  44,  46  ) 
Used  in  section  2. 
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